Theory Preliminaries
section ‹Preliminaries›
theory Preliminaries imports "HOL-Cardinals.Cardinals"
begin
text ‹This section discusses preliminaries on families of items (technically,
partial functions from a type of {\em indexes})
that we call {\em inputs} because they will be inputs to the binding operations.
For inputs, we define some monad-like lifting operators.
We also define simple infinitely branching trees (with no info attached
to the nodes and with branching given by partial functions from
indexes) -- these will be used as ``skeletons'' for terms, giving a size
on which we can induct.
›
abbreviation regular where "regular ≡ stable"
lemmas regular_UNION = stable_UNION
subsection ‹Trivia›
type_synonym 'a pair = "'a * 'a"
type_synonym 'a triple = "'a * 'a *'a"
type_synonym 'a rel = "'a pair set"
definition fst3 where "fst3 == fst"
definition snd3 where "snd3 == fst o snd"
definition trd3 where "trd3 == snd o snd"
lemma fst3_simp[simp]: "fst3 (a,b,c) = a"
unfolding fst3_def by simp
lemma snd3_simp[simp]: "snd3 (a,b,c) = b"
unfolding snd3_def by simp
lemma trd3_simp[simp]: "trd3 (a,b,c) = c"
unfolding trd3_def by simp
lemma fst3_snd3_trd3: "abc = (fst3 abc, snd3 abc, trd3 abc)"
unfolding fst3_def snd3_def trd3_def by auto
lemma fst3_snd3_trd3_rev[simp]:
"(fst3 abc, snd3 abc, trd3 abc) = abc"
using fst3_snd3_trd3[of abc] by simp
lemma map_id[simp]: "map id l = l"
unfolding id_def by simp
abbreviation max3 where
"max3 x y z == max (max x y) z"
lemmas map_id_cong = map_idI
lemma ext2:
"(f ≠ g) = (∃ x. f x ≠ g x)"
using ext by auto
lemma not_equals_and_not_equals_not_in:
"(y ≠ x ∧ y ≠ x' ∧ phi) =
(y ∉ {x,x'} ∧ phi)"
by simp
lemma mp2:
assumes "!! x y. phi x y ⟹ chi x y" and "phi x y"
shows "chi x y"
using assms by simp
lemma mp3:
assumes "!! x y z. phi x y z ⟹ chi x y z" and "phi x y z"
shows "chi x y z"
using assms by simp
lemma all_lt_Suc:
"(∀ i < Suc n. phi i) = ((∀ i < n. phi i) ∧ phi n)"
using less_Suc_eq by auto
declare hd_map[simp]
lemmas tl_map[simp] = list.map_sel
declare last_map[simp]
lemma tl_last[simp]:
assumes "tl L ≠ []"
shows "last (tl L) = last L"
using assms apply - by(induct L, auto)
lemma tl_last_hd:
assumes "L ≠ []" and "tl L = []"
shows "last L = hd L"
using assms apply - by(induct L, auto)
subsection ‹Lexicographic induction›
definition lt2 where
"lt2 == less_than <*lex*> less_than"
definition lt3 where
"lt3 == less_than <*lex*> lt2"
lemma wf_lt2:
"wf lt2"
unfolding lt2_def by auto
lemma wf_lt3:
"wf lt3"
unfolding lt3_def by (auto simp add: wf_lt2)
lemma lt2[intro]:
"!! k1 k2 j1 j2. k1 < j1 ⟹ ((k1,k2),(j1,j2)) ∈ lt2"
"!! k1 k2 j1 j2. ⟦k1 ≤ j1; k2 < j2⟧ ⟹ ((k1,k2),(j1,j2)) ∈ lt2"
unfolding lt2_def by auto
lemma lt3[intro]:
"!! k1 k2 k3 j1 j2 j3. k1 < j1 ⟹ ((k1,k2,k3),(j1,j2,j3)) ∈ lt3"
"!! k1 k2 k3 j1 j2 j3. ⟦k1 ≤ j1; k2 < j2⟧ ⟹ ((k1,k2,k3),(j1,j2,j3)) ∈ lt3"
"!! k1 k2 k3 j1 j2 j3. ⟦k1 ≤ j1; k2 ≤ j2; k3 < j3⟧ ⟹ ((k1,k2,k3),(j1,j2,j3)) ∈ lt3"
unfolding lt3_def by auto
lemma measure_lex2_induct:
fixes h1 :: "'a1 ⇒ nat" and h2 :: "'a2 ⇒ nat"
assumes
"!! x1 x2.
⟦(!! y1 y2. h1 y1 < h1 x1 ⟹ phi y1 y2);
(!! y1 y2. ⟦h1 y1 ≤ h1 x1; h2 y2 < h2 x2⟧ ⟹ phi y1 y2)⟧
⟹ phi x1 x2"
shows "phi x1 x2"
proof-
let ?chi = "%(n1,n2). ALL x1 x2. h1 x1 = n1 ∧ h2 x2 = n2 ⟶ phi x1 x2"
{fix n1 n2
have "?chi (n1,n2)"
apply(rule wf_induct[of lt2 ?chi]) using wf_lt2 assms by blast+
}
thus ?thesis by blast
qed
lemma measure_lex3_induct:
fixes h1 :: "'a1 ⇒ nat" and h2 :: "'a2 ⇒ nat" and h3 :: "'a3 ⇒ nat"
assumes
"!! x1 x2 x3.
⟦(!! y1 y2 y3. h1 y1 < h1 x1 ⟹ phi y1 y2 y3);
(!! y1 y2 y3. ⟦h1 y1 ≤ h1 x1; h2 y2 < h2 x2⟧ ⟹ phi y1 y2 y3);
(!! y1 y2 y3. ⟦h1 y1 ≤ h1 x1; h2 y2 ≤ h2 x2; h3 y3 < h3 x3⟧ ⟹ phi y1 y2 y3)⟧
⟹ phi x1 x2 x3"
shows "phi x1 x2 x3"
proof-
let ?chi = "%(n1,n2,n3). ALL x1 x2 x3. h1 x1 = n1 ∧ h2 x2 = n2 ∧ h3 x3 = n3 ⟶ phi x1 x2 x3"
{fix n1 n2 n3
have "?chi (n1,n2,n3)"
apply(rule wf_induct[of lt3 ?chi]) using wf_lt3 assms by blast+
}
thus ?thesis by blast
qed
subsection ‹Inputs and lifting operators›
type_synonym ('index,'val)input = "'index ⇒ 'val option"
definition
lift :: "('val1 ⇒ 'val2) ⇒ ('index,'val1)input ⇒ ('index,'val2)input"
where
"lift h inp == λi. case inp i of None ⇒ None
|Some v ⇒ Some (h v)"
definition
liftAll :: "('val ⇒ bool) ⇒ ('index,'val)input ⇒ bool"
where
"liftAll phi inp == ∀ i v. inp i = Some v ⟶ phi v"
definition
lift2 ::
"('val1' ⇒ 'val1 ⇒ 'val2) ⇒ ('index,'val1')input ⇒ ('index,'val1)input ⇒ ('index,'val2)input"
where
"lift2 h inp' inp ==
λi. case (inp' i, inp i) of
(Some v',Some v) ⇒ Some (h v' v)
|_ ⇒ None"
definition
sameDom :: "('index,'val1)input ⇒ ('index,'val2)input ⇒ bool"
where "sameDom inp1 inp2 == ∀ i. (inp1 i = None) = (inp2 i = None)"
definition
liftAll2 :: "('val1 ⇒ 'val2 ⇒ bool) ⇒ ('index,'val1)input ⇒ ('index,'val2)input ⇒ bool"
where
"liftAll2 phi inp1 inp2 == (∀ i v1 v2. inp1 i = Some v1 ∧ inp2 i = Some v2 ⟶ phi v1 v2)"
lemma lift_None: "(lift h inp i = None) = (inp i = None)"
unfolding lift_def by (cases "inp i", auto)
lemma lift_Some:
"(∃ v. lift h inp i = Some v) = (∃ v'. inp i = Some v')"
using lift_None[of h inp i] by force
lemma lift_cong[fundef_cong]:
assumes "⋀ i v. inp i = Some v ⟹ h v = h' v"
shows "lift h inp = lift h' inp"
unfolding lift_def apply(rule ext)+
using assms by (case_tac "inp i", auto)
lemma lift_preserves_inj:
assumes "inj f"
shows "inj (lift f)"
unfolding inj_on_def apply auto proof(rule ext)
fix inp inp' i assume *: "lift f inp = lift f inp'"
show "inp i = inp' i"
proof(cases "inp i")
assume inp: "inp i = None"
hence "lift f inp i = None" unfolding lift_def by simp
hence "lift f inp' i = None" using * by simp
hence "inp' i = None" by(auto simp add: lift_None)
thus ?thesis using inp by simp
next
fix v assume inp: "inp i = Some v"
hence "lift f inp i = Some (f v)" unfolding lift_def by simp
hence "lift f inp' i = Some (f v)" using * by simp
then obtain v' where inp': "inp' i = Some v'" and "f v' = f v"
unfolding lift_def by(case_tac "inp' i", auto)
hence "v = v'" using assms unfolding inj_on_def by simp
thus ?thesis using inp inp' by simp
qed
qed
lemma liftAll_cong[fundef_cong]:
assumes "⋀ i v. inp i = Some v ⟹ phi v = phi' v"
shows "liftAll phi inp = liftAll phi' inp"
unfolding liftAll_def apply((rule iff_allI)+) using assms by simp
lemma liftAll2_cong[fundef_cong]:
assumes "⋀ i v1 v2. ⟦inp1 i = Some v1; inp2 i = Some v2⟧ ⟹ phi v1 v2 = phi' v1 v2"
shows "liftAll2 phi inp1 inp2 = liftAll2 phi' inp1 inp2"
unfolding liftAll2_def apply((rule iff_allI)+) using assms by blast
lemma lift_ident: "lift (λv. v) inp = inp"
by(unfold lift_def, rule ext, case_tac "inp i", auto)
lemma lift_id[simp]:
"lift id inp = inp"
unfolding lift_def apply (rule ext) by(case_tac "inp i", auto)
lemma lift_comp: "lift g (lift f inp) = lift (g o f) inp"
by(unfold lift_def o_def, rule ext, case_tac "inp i", auto)
lemma liftAll_mono:
assumes "⋀ v. phi v ⟹ chi v" and "liftAll phi inp"
shows "liftAll chi inp"
using assms unfolding liftAll_def by blast
lemma liftAll_True: "liftAll (λv. True) inp"
unfolding liftAll_def by auto
lemma liftAll_lift_comp: "liftAll phi (lift f inp) = liftAll (phi o f) inp"
unfolding liftAll_def o_def
by (metis (mono_tags, lifting) lift_Some lift_def option.inject option.simps(5))
lemma liftAll_lift_ext:
"liftAll (λ x. f x = g x) inp = (lift f inp = lift g inp)"
unfolding lift_def liftAll_def
by (auto simp: fun_eq_iff option.case_eq_if)
lemma liftAll_and:
"liftAll (λ x. phi x ∧ chi x) inp = (liftAll phi inp ∧ liftAll chi inp)"
unfolding liftAll_def by blast
lemma liftAll_mp:
assumes "liftAll (λ v. phi v ⟶ chi v) inp" and "liftAll phi inp"
shows "liftAll chi inp"
using assms unfolding liftAll_def by auto
lemma sameDom_refl: "sameDom inp inp"
unfolding sameDom_def by auto
lemma sameDom_sym:
"sameDom inp inp' = sameDom inp' inp"
unfolding sameDom_def by auto
lemma sameDom_trans:
"⟦sameDom inp inp'; sameDom inp' inp''⟧ ⟹ sameDom inp inp''"
unfolding sameDom_def by auto
lemma sameDom_lift1:
"sameDom inp (lift f inp)"
unfolding sameDom_def lift_def
by (auto simp: option.case_eq_if)
lemma sameDom_lift2:
"sameDom (lift f inp) inp"
unfolding sameDom_def lift_def
by (auto simp: option.case_eq_if)
lemma sameDom_lift_simp1[simp]:
"sameDom inp (lift f inp') = sameDom inp inp'"
unfolding sameDom_def lift_def by (force simp: fun_eq_iff option.case_eq_if)
lemma sameDom_lift_simp2[simp]:
"sameDom (lift f inp) inp' = sameDom inp inp'"
unfolding sameDom_def lift_def by (force simp: fun_eq_iff option.case_eq_if)
lemma lift_preserves_sameDom:
assumes "sameDom inp inp'"
shows "sameDom (lift f inp) (lift g inp')"
using assms unfolding sameDom_def lift_def
by (force simp: fun_eq_iff option.case_eq_if)
definition comp2 ::
"('b1 ⇒ 'b2 ⇒ 'c) ⇒ ('a1 ⇒ 'b1) ⇒ ('a2 ⇒ 'b2) ⇒ ('a1 ⇒ 'a2 ⇒ 'c)"
("_ o2 '(_,_')" 55)
where "h o2 (f,g) == λ x y. h (f x) (g y)"
lemma comp2_simp[simp]:
"(h o2 (f,g)) x y = h (f x) (g y)"
unfolding comp2_def by simp
lemma comp2_comp:
"((h o2 (f,g)) o2 (f',g')) = (h o2 (f o f', g o g'))"
unfolding comp_def[abs_def] comp2_def[abs_def] by auto
lemma liftAll_imp_liftAll2:
assumes "liftAll (λv. ∀ v'. phi v v') inp"
shows "liftAll2 phi inp inp'"
using assms unfolding liftAll_def liftAll2_def by auto
lemma liftAll2_mono:
assumes "⋀ v v'. phi v v' ⟹ chi v v'" and "liftAll2 phi inp inp'"
shows "liftAll2 chi inp inp'"
using assms unfolding liftAll2_def by blast
lemma liftAll2_True: "liftAll2 (λ v v'. True) inp inp'"
unfolding liftAll2_def by auto
lemma liftAll2_lift_comp2:
"liftAll2 phi (lift f1 inp1) (lift f2 inp2) =
liftAll2 (phi o2 (f1,f2)) inp1 inp2"
unfolding liftAll2_def lift_def
by (auto simp: fun_eq_iff option.case_eq_if)
lemma lift_imp_sameDom:
"lift f inp = lift f inp' ⟹ sameDom inp inp'"
unfolding lift_def sameDom_def
by (force simp: fun_eq_iff option.case_eq_if split: if_splits)
lemma lift_lift2:
"lift f (lift2 g inp' inp) =
lift2 (λ v' v. f (g v' v)) inp' inp"
unfolding lift_def lift2_def
by (force simp: option.case_eq_if split: if_splits)
lemma lift2_left[simp]:
assumes "sameDom inp' inp"
shows "lift2 (λ v' v. v') inp' inp = inp'"
using assms unfolding sameDom_def lift2_def
by (simp add: fun_eq_iff option.case_eq_if) metis
lemma lift2_right[simp]:
assumes "sameDom inp' inp"
shows "lift2 (λ v' v. v) inp' inp = inp"
using assms unfolding sameDom_def lift2_def
by (simp add: fun_eq_iff option.case_eq_if)
lemma lift2_preserves_sameDom:
assumes "sameDom inp' inp1'" and "sameDom inp inp1"
shows "sameDom (lift2 f inp' inp) (lift2 g inp1' inp1)"
using assms unfolding sameDom_def lift2_def
by (simp add: fun_eq_iff option.case_eq_if)
lemma sameDom_lift2_1:
assumes "sameDom inp' inp"
shows
"sameDom inp' (lift2 f inp' inp) ∧
sameDom inp (lift2 f inp' inp)"
using assms unfolding sameDom_def lift2_def
by (simp add: fun_eq_iff option.case_eq_if)
lemma sameDom_lift2_2:
assumes "sameDom inp' inp"
shows
"sameDom (lift2 f inp' inp) inp' ∧
sameDom (lift2 f inp' inp) inp"
using assms unfolding sameDom_def lift2_def
by (simp add: fun_eq_iff option.case_eq_if)
lemma sameDom_lift2_simp1[simp]:
assumes "sameDom inp1' inp1"
shows "sameDom inp (lift2 f inp1' inp1) = sameDom inp inp1'"
using assms unfolding sameDom_def lift2_def
by (simp add: fun_eq_iff option.case_eq_if) (metis not_Some_eq)
lemma sameDom_lift2_simp2[simp]:
assumes "sameDom inp' inp"
shows "sameDom (lift2 f inp' inp) inp1 = sameDom inp' inp1"
using assms unfolding sameDom_def lift2_def
by (simp add: fun_eq_iff option.case_eq_if) (metis not_Some_eq)
lemma liftAll2_lift_ext:
"(sameDom inp inp' ∧ liftAll2 (λ v v'. f v = f v') inp inp') =
(lift f inp = lift f inp')"
unfolding sameDom_def lift_def liftAll2_def
by (force simp add: fun_eq_iff option.case_eq_if)
lemma liftAll2_and:
"liftAll2 (λ v v'. phi v v' ∧ chi v v') inp inp' =
(liftAll2 phi inp inp' ∧ liftAll2 chi inp inp')"
unfolding liftAll2_def by force
lemma liftAll2_mp:
assumes "liftAll2 (λ v v'. phi v v' ⟶ chi v v') inp inp'" and "liftAll2 phi inp inp'"
shows "liftAll2 chi inp inp'"
using assms unfolding liftAll2_def by auto
lemma sameDom_and_liftAll2_iff:
"(sameDom inp inp' ∧ liftAll2 phi inp inp') =
(∀ i. (inp i = None ∧ inp' i = None) ∨
(∃ v v'. inp i = Some v ∧ inp' i = Some v' ∧ phi v v'))"
unfolding sameDom_def liftAll2_def
apply (auto simp add: fun_eq_iff option.case_eq_if)
using option.sel by fastforce
subsection ‹Doubly infinitely-branching trees›
text "These simple infinitary trees shall be used for measuring the sizes
of possibly infinitary terms."
datatype ('index,'bindex)tree =
Branch "('index,('index,'bindex)tree) input" "('bindex,('index,'bindex)tree) input"
lemma tree_induct:
fixes phi::"('index,'bindex)tree ⇒ bool" and T::"('index,'bindex)tree"
assumes
"⋀ inp binp. ⟦liftAll phi inp; liftAll phi binp⟧ ⟹ phi (Branch inp binp)"
shows "phi T"
using assms unfolding liftAll_def
by (induct T) (simp, metis rangeI)
definition treeLess :: "('index,'bindex)tree rel"
where
"treeLess ==
{(T,T'). ∃ inp binp i j. T' = Branch inp binp ∧ (inp i = Some T ∨ binp j = Some T)}"
lemma treeLess_induct:
fixes phi::"('index,'bindex)tree ⇒ bool" and
T::"('index,'bindex)tree"
assumes "⋀ T'. (⋀ T. (T,T') ∈ treeLess ⟹ phi T) ⟹ phi T'"
shows "phi T"
apply(induct rule: tree_induct)
using assms unfolding treeLess_def liftAll_def
by simp (metis tree.inject)
lemma treeLess_wf: "wf treeLess"
unfolding wf_def using treeLess_induct by blast
subsection ‹Ordering›
lemma Least_Max:
assumes phi: "phi (n::nat)" and fin: "finite {n. phi n}"
shows "(LEAST m. ∀ n. phi n ⟶ n ≤ m) =
Max {n. phi n}"
using assms Max_in by (intro Least_equality) auto
end
Theory QuasiTerms_Swap_Fresh
section ‹Quasi-Terms with Swapping and Freshness›
theory QuasiTerms_Swap_Fresh imports Preliminaries
begin
text‹
This section defines and studies the (totally free) datatype of quasi-terms
and the notions of freshness and
swapping variables for them.
``Quasi" refers to the fact that these items are not (yet) factored to alpha-equivalence.
We shall later call ``terms" those alpha-equivalence classes.›
subsection ‹The datatype of quasi-terms with bindings›
datatype
('index,'bindex,'varSort,'var,'opSym)qTerm =
qVar 'varSort 'var
|qOp 'opSym "('index, (('index,'bindex,'varSort,'var,'opSym)qTerm))input"
"('bindex, (('index,'bindex,'varSort,'var,'opSym)qAbs)) input"
and
('index,'bindex,'varSort,'var,'opSym)qAbs =
qAbs 'varSort 'var "('index,'bindex,'varSort,'var,'opSym)qTerm"
text‹Above:
\begin{itemize}
\item ``Var" stands for ``variable injection"
\item ``Op" stands for ``operation"
\item ``opSym" stands for ``operation symbol"
\item ``q" stands for ``quasi"
\item ``Abs" stands for ``abstraction"
\end{itemize}
Thus, a quasi-term is either (an injection of) a variable, or an operation symbol applied
to a term-input and an abstraction-input
(where, for any type $T$, $T$-inputs are partial
maps from indexes to $T$. A quasi-abstraction is
essentially a pair (variable,quasi-term).
›
type_synonym ('index,'bindex,'varSort,'var,'opSym)qTermItem =
"('index,'bindex,'varSort,'var,'opSym)qTerm +
('index,'bindex,'varSort,'var,'opSym)qAbs"
abbreviation termIn ::
"('index,'bindex,'varSort,'var,'opSym)qTerm ⇒ ('index,'bindex,'varSort,'var,'opSym)qTermItem"
where "termIn X == Inl X"
abbreviation absIn ::
"('index,'bindex,'varSort,'var,'opSym)qAbs ⇒ ('index,'bindex,'varSort,'var,'opSym)qTermItem"
where "absIn A == Inr A"
subsection ‹Induction principles›
definition qTermLess :: "('index,'bindex,'varSort,'var,'opSym)qTermItem rel"
where
"qTermLess == {(termIn X, termIn(qOp delta inp binp))| X delta inp binp i. inp i = Some X} ∪
{(absIn A, termIn(qOp delta inp binp))| A delta inp binp i. binp i = Some A} ∪
{(termIn X, absIn (qAbs xs x X))| X xs x. True}"
text‹This induction will be used only temporarily, until we
get a better one, involving swapping:›
lemma qTerm_rawInduct[case_names Var Op Abs]:
fixes X :: "('index,'bindex,'varSort,'var,'opSym)qTerm" and
A :: "('index,'bindex,'varSort,'var,'opSym)qAbs" and phi phiAbs
assumes
Var: "⋀ xs x. phi (qVar xs x)" and
Op: "⋀ delta inp binp. ⟦liftAll phi inp; liftAll phiAbs binp⟧ ⟹ phi (qOp delta inp binp)" and
Abs: "⋀ xs x X. phi X ⟹ phiAbs (qAbs xs x X)"
shows "phi X ∧ phiAbs A"
by (induct rule: qTerm_qAbs.induct)
(fastforce intro!: Var Op Abs rangeI simp: liftAll_def)+
lemma qTermLess_wf: "wf qTermLess"
unfolding wf_def proof safe
fix chi item
assume *: "∀item. (∀item'. (item', item) ∈ qTermLess ⟶ chi item') ⟶ chi item"
show "chi item"
proof-
{fix X A
have "chi (termIn X) ∧ chi (absIn A)"
apply(induct rule: qTerm_rawInduct)
using * unfolding qTermLess_def liftAll_def by blast+
}
thus ?thesis by(cases item) auto
qed
qed
lemma qTermLessPlus_wf: "wf (qTermLess ^+)"
using qTermLess_wf wf_trancl by auto
text‹The skeleton of a quasi-term item -- this is the generalization
of the size function from the case of finitary syntax.
We use the skeleton later for proving correct various recursive function definitions, notably that of ``alpha".›
function
qSkel :: "('index,'bindex,'varSort,'var,'opSym)qTerm ⇒ ('index,'bindex)tree"
and
qSkelAbs :: "('index,'bindex,'varSort,'var,'opSym)qAbs ⇒ ('index,'bindex)tree"
where
"qSkel (qVar xs x) = Branch (λi. None) (λi. None)"
|
"qSkel (qOp delta inp binp) = Branch (lift qSkel inp) (lift qSkelAbs binp)"
|
"qSkelAbs (qAbs xs x X) = Branch (λi. Some(qSkel X)) (λi. None)"
by(pat_completeness, auto)
termination by(relation qTermLess, simp add: qTermLess_wf, auto simp add: qTermLess_def)
text‹Next is a template for generating induction principles whenever we come up
with relation on terms included in the kernel of the skeleton operator.›
lemma qTerm_templateInduct[case_names Var Op Abs]:
fixes X :: "('index,'bindex,'varSort,'var,'opSym)qTerm"
and A :: "('index,'bindex,'varSort,'var,'opSym)qAbs"
and phi phiAbs and rel
assumes
REL: "⋀ X Y. (X,Y) ∈ rel ⟹ qSkel Y = qSkel X" and
Var: "⋀ xs x. phi (qVar xs x)" and
Op: "⋀ delta inp binp. ⟦liftAll phi inp; liftAll phiAbs binp⟧
⟹ phi (qOp delta inp binp)" and
Abs: "⋀ xs x X. (⋀ Y. (X,Y) ∈ rel ⟹ phi Y) ⟹ phiAbs (qAbs xs x X)"
shows "phi X ∧ phiAbs A"
proof-
{fix T
have "∀ X A. (T = qSkel X ⟶ phi X) ∧ (T = qSkelAbs A ⟶ phiAbs A)"
proof(induct rule: treeLess_induct)
case (1 T')
show ?case apply safe
subgoal for X _
using assms 1 unfolding treeLess_def liftAll_def
by (cases X) (auto simp add: lift_def, metis option.simps(5))
subgoal for _ A apply (cases A)
using assms 1 unfolding treeLess_def by simp .
qed
}
thus ?thesis by blast
qed
text‹A modification of the canonical immediate-subterm
relation on quasi-terms, that takes into account a relation assumed included in the skeleton kernel.›
definition qTermLess_modulo ::
"('index,'bindex,'varSort,'var,'opSym)qTerm rel ⇒
('index,'bindex,'varSort,'var,'opSym)qTermItem rel"
where
"qTermLess_modulo rel ==
{(termIn X, termIn(qOp delta inp binp))| X delta inp binp i. inp i = Some X} ∪
{(absIn A, termIn(qOp delta inp binp))| A delta inp binp j. binp j = Some A} ∪
{(termIn Y, absIn (qAbs xs x X))| X Y xs x. (X,Y) ∈ rel}"
lemma qTermLess_modulo_wf:
fixes rel::"('index,'bindex,'varSort,'var,'opSym)qTerm rel"
assumes "⋀ X Y. (X,Y) ∈ rel ⟹ qSkel Y = qSkel X"
shows "wf (qTermLess_modulo rel)"
proof(unfold wf_def, auto)
fix chi item
assume *:
"∀item. (∀item'. (item', item) ∈ qTermLess_modulo rel ⟶ chi item')
⟶ chi item"
show "chi item"
proof-
obtain phi where phi_def: "phi = (λ X. chi (termIn X))" by blast
obtain phiAbs where phiAbs_def: "phiAbs = (λ A. chi (absIn A))" by blast
{fix X A
have "chi (termIn X) ∧ chi (absIn A)"
apply(induct rule: qTerm_templateInduct[of rel])
using * assms unfolding qTermLess_modulo_def liftAll_def by blast+
}
thus ?thesis unfolding phi_def phiAbs_def
by(cases item, auto)
qed
qed
subsection ‹Swap and substitution on variables›
definition sw :: "'varSort ⇒ 'var ⇒ 'var ⇒ 'varSort ⇒ 'var ⇒ 'var"
where
"sw ys y1 y2 xs x ==
if ys = xs then if x = y1 then y2
else if x = y2 then y1
else x
else x"
abbreviation sw_abbrev :: "'var ⇒ 'varSort ⇒ 'var ⇒ 'var ⇒ 'varSort ⇒ 'var"
("_ @_[_ ∧ _]'__" 200)
where "(x @xs[y1 ∧ y2]_ys) == sw ys y1 y2 xs x"
definition sb :: "'varSort ⇒ 'var ⇒ 'var ⇒ 'varSort ⇒ 'var ⇒ 'var"
where
"sb ys y1 y2 xs x ==
if ys = xs then if x = y2 then y1
else x
else x"
abbreviation sb_abbrev :: "'var ⇒ 'varSort ⇒ 'var ⇒ 'var ⇒ 'varSort ⇒ 'var"
("_ @_[_ '/ _]'__" 200)
where "(x @xs[y1 / y2]_ys) == sb ys y1 y2 xs x"
theorem sw_simps1[simp]: "(x @xs[x ∧ y]_xs) = y"
unfolding sw_def by simp
theorem sw_simps2[simp]: "(x @xs[y ∧ x]_xs) = y"
unfolding sw_def by simp
theorem sw_simps3[simp]:
"(zs ≠ xs ∨ x ∉ {z1,z2}) ⟹ (x @xs[z1 ∧ z2]_zs) = x"
unfolding sw_def by simp
lemmas sw_simps = sw_simps1 sw_simps2 sw_simps3
theorem sw_ident[simp]: "(x @xs[y ∧ y]_ys) = x"
unfolding sw_def by auto
theorem sw_compose:
"((z @zs[x ∧ y]_xs) @zs[x' ∧ y']_xs') =
((z @zs[x' ∧ y']_xs') @zs[(x @xs[x' ∧ y']_xs') ∧ (y @xs[x' ∧ y']_xs')]_xs)"
by(unfold sw_def, auto)
theorem sw_commute:
assumes "zs ≠ zs' ∨ {x,y} Int {x',y'} = {}"
shows "((u @us[x ∧ y]_zs) @us[x' ∧ y']_zs') = ((u @us[x' ∧ y']_zs') @us[x ∧ y]_zs)"
using assms by(unfold sw_def, auto)
theorem sw_involutive[simp]:
"((z @zs[x ∧ y]_xs) @zs[x ∧ y]_xs) = z"
by(unfold sw_def, auto)
theorem sw_inj[simp]:
"((z @zs[x ∧ y]_xs) = (z' @zs[x ∧ y]_xs)) = (z = z')"
by (simp add: sw_def)
lemma sw_preserves_mship[simp]:
assumes "{y1,y2} ⊆ Var ys"
shows "((x @xs[y1 ∧ y2]_ys) ∈ Var xs) = (x ∈ Var xs)"
using assms unfolding sw_def by auto
theorem sw_sym:
"(z @zs[x ∧ y]_xs) = (z @zs[y ∧ x]_xs)"
by (unfold sw_def) auto
theorem sw_involutive2[simp]:
"((z @zs[x ∧ y]_xs) @zs[y ∧ x]_xs) = z"
by (unfold sw_def) auto
theorem sw_trans:
"us ≠ zs ∨ u ∉ {y,z} ⟹
((u @us[y ∧ x]_zs) @us[z ∧ y]_zs) = (u @us[z ∧ x]_zs)"
by (unfold sw_def) auto
lemmas sw_otherSimps =
sw_ident sw_involutive sw_inj sw_preserves_mship sw_involutive2
theorem sb_simps1[simp]: "(x @xs[y / x]_xs) = y"
unfolding sb_def by simp
theorem sb_simps2[simp]:
"(zs ≠ xs ∨ z2 ≠ x) ⟹ (x @xs[z1 / z2]_zs) = x"
unfolding sb_def by auto
lemmas sb_simps = sb_simps1 sb_simps2
theorem sb_ident[simp]: "(x @xs[y / y]_ys) = x"
unfolding sb_def by auto
theorem sb_compose1:
"((z @zs[y1 / x]_xs) @zs[y2 / x]_xs) = (z @zs[(y1 @xs[y2 / x]_xs) / x]_xs)"
by(unfold sb_def, auto)
theorem sb_compose2:
"ys ≠ xs ∨ (x2 ∉ {y1,y2}) ⟹
((z @zs[x1 / x2]_xs) @zs[y1 / y2]_ys) =
((z @zs[y1 / y2]_ys) @zs[(x1 @xs[y1 / y2]_ys) / x2]_xs)"
by (unfold sb_def) auto
theorem sb_commute:
assumes "zs ≠ zs' ∨ {x,y} Int {x',y'} = {}"
shows "((u @us[x / y]_zs) @us[x' / y']_zs') = ((u @us[x' / y']_zs') @us[x / y]_zs)"
using assms by (unfold sb_def) auto
theorem sb_idem[simp]:
"((z @zs[x / y]_xs) @zs[x / y]_xs) = (z @zs[x / y]_xs)"
by (unfold sb_def) auto
lemma sb_preserves_mship[simp]:
assumes "{y1,y2} ⊆ Var ys"
shows "((x @xs[y1 / y2]_ys) ∈ Var xs) = (x ∈ Var xs)"
using assms by (unfold sb_def) auto
theorem sb_trans:
"us ≠ zs ∨ u ≠ y ⟹
((u @us[y / x]_zs) @us[z / y]_zs) = (u @us[z / x]_zs)"
by (unfold sb_def) auto
lemmas sb_otherSimps =
sb_ident sb_idem sb_preserves_mship
subsection ‹The swapping and freshness operators›
text ‹For establishing the preliminary results quickly, we use both the notion of
binding-sensitive freshness (operator ``qFresh")
and that of ``absolute" freshness, ignoring bindings (operator ``qAFresh"). Later,
for alpha-equivalence classes, ``qAFresh" will not make sense.›
definition
aux_qSwap_ignoreFirst3 ::
"'varSort * 'var * 'var * ('index,'bindex,'varSort,'var,'opSym)qTerm +
'varSort * 'var * 'var * ('index,'bindex,'varSort,'var,'opSym)qAbs ⇒
('index,'bindex,'varSort,'var,'opSym)qTermItem"
where
"aux_qSwap_ignoreFirst3 K =
(case K of Inl(zs,x,y,X) ⇒ termIn X
|Inr(zs,x,y,A) ⇒ absIn A)"
lemma qTermLess_ingoreFirst3_wf:
"wf(inv_image qTermLess aux_qSwap_ignoreFirst3)"
using qTermLess_wf wf_inv_image by auto
function
qSwap :: "'varSort ⇒ 'var ⇒ 'var ⇒ ('index,'bindex,'varSort,'var,'opSym)qTerm ⇒
('index,'bindex,'varSort,'var,'opSym)qTerm"
and
qSwapAbs :: "'varSort ⇒ 'var ⇒ 'var ⇒ ('index,'bindex,'varSort,'var,'opSym)qAbs ⇒
('index,'bindex,'varSort,'var,'opSym)qAbs"
where
"qSwap zs x y (qVar zs' z) = qVar zs' (z @zs'[x ∧ y]_zs)"
|
"qSwap zs x y (qOp delta inp binp) =
qOp delta (lift (qSwap zs x y) inp) (lift (qSwapAbs zs x y) binp)"
|
"qSwapAbs zs x y (qAbs zs' z X) = qAbs zs' (z @zs'[x ∧ y]_zs) (qSwap zs x y X)"
by(pat_completeness, auto)
termination
by(relation "inv_image qTermLess aux_qSwap_ignoreFirst3",
simp add: qTermLess_ingoreFirst3_wf,
auto simp add: qTermLess_def aux_qSwap_ignoreFirst3_def)
lemmas qSwapAll_simps = qSwap.simps qSwapAbs.simps
abbreviation qSwap_abbrev ::
"('index,'bindex,'varSort,'var,'opSym)qTerm ⇒ 'var ⇒ 'var ⇒ 'varSort ⇒
('index,'bindex,'varSort,'var,'opSym)qTerm" ("_ #[[_ ∧ _]]'__" 200)
where "(X #[[z1 ∧ z2]]_zs) == qSwap zs z1 z2 X"
abbreviation qSwapAbs_abbrev ::
"('index,'bindex,'varSort,'var,'opSym)qAbs ⇒ 'var ⇒ 'var ⇒ 'varSort ⇒
('index,'bindex,'varSort,'var,'opSym)qAbs" ("_ $[[_ ∧ _]]'__" 200)
where "(A $[[z1 ∧ z2]]_zs) == qSwapAbs zs z1 z2 A"
definition
aux_qFresh_ignoreFirst2 ::
"'varSort * 'var * ('index,'bindex,'varSort,'var,'opSym)qTerm +
'varSort * 'var * ('index,'bindex,'varSort,'var,'opSym)qAbs ⇒
('index,'bindex,'varSort,'var,'opSym)qTermItem"
where
"aux_qFresh_ignoreFirst2 K =
(case K of Inl(zs,x,X) ⇒ termIn X
|Inr (zs,x,A) ⇒ absIn A)"
lemma qTermLess_ingoreFirst2_wf: "wf(inv_image qTermLess aux_qFresh_ignoreFirst2)"
using qTermLess_wf wf_inv_image by auto
text‹The quasi absolutely-fresh predicate:
(note that this is not an oxymoron: ``quasi" refers
to being an operator on quasi-terms, and not on
terms, i.e., on alpha-equivalence classes;
``absolutely'' refers to not ignoring bindings in the notion of freshness,
and thus counting absolutely all the variables.›
function
qAFresh :: "'varSort ⇒ 'var ⇒ ('index,'bindex,'varSort,'var,'opSym)qTerm ⇒ bool"
and
qAFreshAbs :: "'varSort ⇒ 'var ⇒ ('index,'bindex,'varSort,'var,'opSym)qAbs ⇒ bool"
where
"qAFresh xs x (qVar ys y) = (xs ≠ ys ∨ x ≠ y)"
|
"qAFresh xs x (qOp delta inp binp) =
(liftAll (qAFresh xs x) inp ∧ liftAll (qAFreshAbs xs x) binp)"
|
"qAFreshAbs xs x (qAbs ys y X) = ((xs ≠ ys ∨ x ≠ y) ∧ qAFresh xs x X)"
by(pat_completeness, auto)
termination
by(relation "inv_image qTermLess aux_qFresh_ignoreFirst2",
simp add: qTermLess_ingoreFirst2_wf,
auto simp add: qTermLess_def aux_qFresh_ignoreFirst2_def)
lemmas qAFreshAll_simps = qAFresh.simps qAFreshAbs.simps
text‹The next is standard freshness -- note that its definition differs from that
of absolute freshness only at the clause for abstractions.›
function
qFresh :: "'varSort ⇒ 'var ⇒ ('index,'bindex,'varSort,'var,'opSym)qTerm ⇒ bool"
and
qFreshAbs :: "'varSort ⇒ 'var ⇒ ('index,'bindex,'varSort,'var,'opSym)qAbs ⇒ bool"
where
"qFresh xs x (qVar ys y) = (xs ≠ ys ∨ x ≠ y)"
|
"qFresh xs x (qOp delta inp binp) =
(liftAll (qFresh xs x) inp ∧ liftAll (qFreshAbs xs x) binp)"
|
"qFreshAbs xs x (qAbs ys y X) = ((xs = ys ∧ x = y) ∨ qFresh xs x X)"
by(pat_completeness, auto)
termination
by(relation "inv_image qTermLess aux_qFresh_ignoreFirst2",
simp add: qTermLess_ingoreFirst2_wf,
auto simp add: qTermLess_def aux_qFresh_ignoreFirst2_def)
lemmas qFreshAll_simps = qFresh.simps qFreshAbs.simps
subsection ‹Compositional properties of swapping›
lemma qSwapAll_ident:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs"
shows "(X #[[x ∧ x]]_zs) = X ∧ (A $[[x ∧ x]]_zs) = A"
by (induct rule: qTerm_rawInduct)
(auto simp add: liftAll_def lift_cong lift_ident)
corollary qSwap_ident[simp]: "(X #[[x ∧ x]]_zs) = X"
by(simp add: qSwapAll_ident)
lemma qSwapAll_compose:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and zs x y x' y'
shows
"((X #[[x ∧ y]]_zs) #[[x' ∧ y']]_zs') =
((X #[[x' ∧ y']]_zs') #[[(x @zs[x' ∧ y']_zs') ∧ (y @zs[x' ∧ y']_zs')]]_zs)
∧
((A $[[x ∧ y]]_zs) $[[x' ∧ y']]_zs') =
((A $[[x' ∧ y']]_zs') $[[(x @zs[x' ∧ y']_zs') ∧ (y @zs[x' ∧ y']_zs')]]_zs)"
proof(induct rule: qTerm_rawInduct[of _ _ X A])
case (Op delta inp binp)
then show ?case by (auto intro!: lift_cong simp: liftAll_def lift_comp)
qed (auto simp add: sw_def sw_compose)
corollary qSwap_compose:
"((X #[[x ∧ y]]_zs) #[[x' ∧ y']]_zs') =
((X #[[x' ∧ y']]_zs') #[[(x @zs[x' ∧ y']_zs') ∧ (y @zs[x' ∧ y']_zs')]]_zs)"
by (meson qSwapAll_compose)
lemma qSwap_commute:
assumes "zs ≠ zs' ∨ {x,y} Int {x',y'} = {}"
shows "((X #[[x ∧ y]]_zs) #[[x' ∧ y']]_zs') = ((X #[[x' ∧ y']]_zs') #[[x ∧ y]]_zs)"
by (metis assms disjoint_insert(1) qSwapAll_compose sw_simps3)
lemma qSwapAll_involutive:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and zs x y
shows "((X #[[x ∧ y]]_zs) #[[x ∧ y]]_zs) = X ∧
((A $[[x ∧ y]]_zs) $[[x ∧ y]]_zs) = A"
proof(induct rule: qTerm_rawInduct[of _ _ X A])
case (Op delta inp binp)
then show ?case
unfolding qSwapAll_simps(2) liftAll_lift_ext
lift_comp o_def
by (simp add: lift_ident)
qed(auto)
corollary qSwap_involutive[simp]:
"((X #[[x ∧ y]]_zs) #[[x ∧ y]]_zs) = X"
by(simp add: qSwapAll_involutive)
lemma qSwapAll_sym:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and zs x y
shows "(X #[[x ∧ y]]_zs) = (X #[[y ∧ x]]_zs) ∧
(A $[[x ∧ y]]_zs) = (A $[[y ∧ x]]_zs)"
by (induct rule: qTerm_rawInduct[of _ _ X A])
(auto simp: sw_sym lift_comp liftAll_lift_ext)
corollary qSwap_sym:
"(X #[[x ∧ y]]_zs) = (X #[[y ∧ x]]_zs)"
by(simp add: qSwapAll_sym)
lemma qAFreshAll_qSwapAll_id:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and zs z1 z2
shows "(qAFresh zs z1 X ∧ qAFresh zs z2 X ⟶ (X #[[z1 ∧ z2]]_zs) = X) ∧
(qAFreshAbs zs z1 A ∧ qAFreshAbs zs z2 A ⟶ (A $[[z1 ∧ z2]]_zs) = A)"
by (induct rule: qTerm_rawInduct[of _ _ X A])
(auto intro!: ext simp: liftAll_def lift_def option.case_eq_if)
corollary qAFresh_qSwap_id[simp]:
"⟦qAFresh zs z1 X; qAFresh zs z2 X⟧ ⟹ (X #[[z1 ∧ z2]]_zs) = X"
by(simp add: qAFreshAll_qSwapAll_id)
lemma qAFreshAll_qSwapAll_compose:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs"and zs x y z
shows "(qAFresh zs y X ∧ qAFresh zs z X ⟶
((X #[[y ∧ x]]_zs) #[[z ∧ y]]_zs) = (X #[[z ∧ x]]_zs)) ∧
(qAFreshAbs zs y A ∧ qAFreshAbs zs z A ⟶
((A $[[y ∧ x]]_zs) $[[z ∧ y]]_zs) = (A $[[z ∧ x]]_zs))"
by (induct rule: qTerm_rawInduct[of _ _ X A])
(auto intro!: ext simp: sw_trans lift_comp lift_def liftAll_def option.case_eq_if)
corollary qAFresh_qSwap_compose:
"⟦qAFresh zs y X; qAFresh zs z X⟧ ⟹
((X #[[y ∧ x]]_zs) #[[z ∧ y]]_zs) = (X #[[z ∧ x]]_zs)"
by(simp add: qAFreshAll_qSwapAll_compose)
subsection ‹Induction and well-foundedness modulo swapping›
lemma qSkel_qSwapAll:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and x y zs
shows "qSkel(X #[[x ∧ y]]_zs) = qSkel X ∧
qSkelAbs(A $[[x ∧ y]]_zs) = qSkelAbs A"
proof(induct rule: qTerm_rawInduct[of _ _ X A])
case (Op delta inp binp)
then show ?case
unfolding qSwapAll_simps(2) liftAll_lift_ext qSkel.simps(2)
lift_comp comp_apply by simp
qed auto
corollary qSkel_qSwap: "qSkel(X #[[x ∧ y]]_zs) = qSkel X"
by(simp add: qSkel_qSwapAll)
text‹
For induction modulo swapping, one may wish to swap not just once,
but several times at the
induction hypothesis (an example of this will be the proof of compatibility
of ``qSwap" with alpha) -- for this, we introduce the following relation
(the suffix ``Raw" signifies the fact that the involved variables are
not required to be well-sorted):›
inductive_set qSwapped :: "('index,'bindex,'varSort,'var,'opSym)qTerm rel"
where
Refl: "(X,X) ∈ qSwapped"
|
Trans: "⟦(X,Y) ∈ qSwapped; (Y,Z) ∈ qSwapped⟧ ⟹ (X,Z) ∈ qSwapped"
|
Swap: "(X,Y) ∈ qSwapped ⟹ (X, Y #[[x ∧ y]]_zs) ∈ qSwapped"
lemmas qSwapped_Clauses = qSwapped.Refl qSwapped.Trans qSwapped.Swap
lemma qSwap_qSwapped: "(X, X #[[x ∧ y]]_zs): qSwapped"
by (auto simp add: qSwapped_Clauses)
lemma qSwapped_qSkel:
"(X,Y) ∈ qSwapped ⟹ qSkel Y = qSkel X"
by(erule qSwapped.induct, auto simp add: qSkel_qSwap)
text‹The following is henceforth our main induction principle for quasi-terms. At the
clause for abstractions, the user may choose among the two
induction hypotheses (IHs):
\\-(1) IH for all swapped terms
\\-(2) IH for all terms with the same skeleton.
The user may choose only one of the above, and ignore the others, but may of course also
assume both. (2) is stronger than (1),
but we offer both of them for convenience in proofs.
Most of the times, (1) will be the most convenient.›
lemma qTerm_induct[case_names Var Op Abs]:
fixes X :: "('index,'bindex,'varSort,'var,'opSym)qTerm"
and A :: "('index,'bindex,'varSort,'var,'opSym)qAbs" and phi phiAbs
assumes
Var: "⋀ xs x. phi (qVar xs x)" and
Op: "⋀ delta inp binp. ⟦liftAll phi inp; liftAll phiAbs binp⟧
⟹ phi (qOp delta inp binp)" and
Abs: "⋀ xs x X. ⟦⋀ Y. (X,Y) ∈ qSwapped ⟹ phi Y;
⋀ Y. qSkel Y = qSkel X ⟹ phi Y⟧
⟹ phiAbs (qAbs xs x X)"
shows "phi X ∧ phiAbs A"
by (induct rule: qTerm_templateInduct[of "qSwapped ∪ {(X,Y). qSkel Y = qSkel X}"],
auto simp add: qSwapped_qSkel assms)
text‹The following relation will be needed for proving alpha-equivalence well-defined:›
definition qTermQSwappedLess :: "('index,'bindex,'varSort,'var,'opSym)qTermItem rel"
where "qTermQSwappedLess = qTermLess_modulo qSwapped"
lemma qTermQSwappedLess_wf: "wf qTermQSwappedLess"
unfolding qTermQSwappedLess_def
using qSwapped_qSkel qTermLess_modulo_wf[of qSwapped] by blast
subsection‹More properties connecting swapping and freshness›
lemma qSwap_3commute:
assumes *: "qAFresh ys y X" and **: "qAFresh ys y0 X"
and ***: "ys ≠ zs ∨ y0 ∉ {z1,z2}"
shows "((X #[[z1 ∧ z2]]_zs) #[[y0 ∧ x @ys[z1 ∧ z2]_zs]]_ys) =
(((X #[[y ∧ x]]_ys) #[[y0 ∧ y]]_ys) #[[z1 ∧ z2]]_zs)"
proof-
have "y0 = (y0 @ys[z1 ∧ z2]_zs)" using *** unfolding sw_def by auto
hence "((X #[[z1 ∧ z2]]_zs) #[[y0 ∧ x @ys[z1 ∧ z2]_zs]]_ys) =
((X #[[y0 ∧ x]]_ys) #[[z1 ∧ z2]]_zs)"
by(simp add: qSwap_compose[of _ z1])
also have "((X #[[y0 ∧ x]]_ys) #[[z1 ∧ z2]]_zs) =
(((X #[[y ∧ x]]_ys) #[[y0 ∧ y]]_ys) #[[z1 ∧ z2]]_zs)"
using * ** by (simp add: qAFresh_qSwap_compose)
finally show ?thesis .
qed
lemma qAFreshAll_imp_qFreshAll:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and xs x
shows "(qAFresh xs x X ⟶ qFresh xs x X) ∧
(qAFreshAbs xs x A ⟶ qFreshAbs xs x A)"
by(induct rule: qTerm_rawInduct, auto simp add: liftAll_def)
corollary qAFresh_imp_qFresh:
"qAFresh xs x X ⟹ qFresh xs x X"
by(simp add: qAFreshAll_imp_qFreshAll)
lemma qSwapAll_preserves_qAFreshAll:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and ys y zs z1 z2
shows
"(qAFresh ys (y @ys[z1 ∧ z2]_zs) (X #[[z1 ∧ z2]]_zs) = qAFresh ys y X) ∧
(qAFreshAbs ys (y @ys[z1 ∧ z2]_zs) (A $[[z1 ∧ z2]]_zs) = qAFreshAbs ys y A)"
proof(induct rule: qTerm_rawInduct[of _ _ X A])
case (Op delta inp binp)
then show ?case
unfolding qAFreshAll_simps(2) qSwapAll_simps(2) liftAll_lift_comp o_def
unfolding liftAll_def by presburger
qed(auto simp add: sw_def)
corollary qSwap_preserves_qAFresh[simp]:
"(qAFresh ys (y @ys[z1 ∧ z2]_zs) (X #[[z1 ∧ z2]]_zs) = qAFresh ys y X)"
by(simp add: qSwapAll_preserves_qAFreshAll)
lemma qSwap_preserves_qAFresh_distinct:
assumes "ys ≠ zs ∨ y ∉ {z1,z2}"
shows "qAFresh ys y (X #[[z1 ∧ z2]]_zs) = qAFresh ys y X"
proof-
have "y = (y @ys[z1 ∧ z2]_zs)" using assms unfolding sw_def by auto
thus ?thesis using qSwap_preserves_qAFresh[of ys zs z1 z2 y] by auto
qed
lemma qAFresh_qSwap_exchange1:
"qAFresh zs z2 (X #[[z1 ∧ z2]]_zs) = qAFresh zs z1 X"
proof-
have "z2 = (z1 @zs[z1 ∧ z2]_zs)" unfolding sw_def by auto
thus ?thesis using qSwap_preserves_qAFresh[of zs zs z1 z2 z1 X] by auto
qed
lemma qAFresh_qSwap_exchange2:
"qAFresh zs z2 (X #[[z2 ∧ z1]]_zs) = qAFresh zs z1 X"
by(auto simp add: qAFresh_qSwap_exchange1 qSwap_sym)
lemma qSwapAll_preserves_qFreshAll:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and ys y zs z1 z2
shows
"(qFresh ys (y @ys[z1 ∧ z2]_zs) (X #[[z1 ∧ z2]]_zs) = qFresh ys y X) ∧
(qFreshAbs ys (y @ys[z1 ∧ z2]_zs) (A $[[z1 ∧ z2]]_zs) = qFreshAbs ys y A)"
proof(induct rule: qTerm_rawInduct[of _ _ X A])
case (Op delta inp binp)
then show ?case
unfolding qFreshAll_simps(2) qSwapAll_simps(2) liftAll_lift_comp o_def
unfolding liftAll_def by presburger
qed (auto simp add: sw_def)
corollary qSwap_preserves_qFresh:
"(qFresh ys (y @ys[z1 ∧ z2]_zs) (X #[[z1 ∧ z2]]_zs) = qFresh ys y X)"
by(simp add: qSwapAll_preserves_qFreshAll)
lemma qSwap_preserves_qFresh_distinct:
assumes "ys ≠ zs ∨ y ∉ {z1,z2}"
shows "qFresh ys y (X #[[z1 ∧ z2]]_zs) = qFresh ys y X"
proof-
have "y = (y @ys[z1 ∧ z2]_zs)" using assms unfolding sw_def by auto
thus ?thesis using qSwap_preserves_qFresh[of ys zs z1 z2 y] by auto
qed
lemma qFresh_qSwap_exchange1:
"qFresh zs z2 (X #[[z1 ∧ z2]]_zs) = qFresh zs z1 X"
proof-
have "z2 = (z1 @zs[z1 ∧ z2]_zs)" unfolding sw_def by auto
thus ?thesis using qSwap_preserves_qFresh[of zs zs z1 z2 z1 X] by auto
qed
lemma qFresh_qSwap_exchange2:
"qFresh zs z1 X = qFresh zs z2 (X #[[z2 ∧ z1]]_zs)"
by (auto simp add: qFresh_qSwap_exchange1 qSwap_sym)
lemmas qSwap_qAFresh_otherSimps =
qSwap_ident qSwap_involutive qAFresh_qSwap_id qSwap_preserves_qAFresh
end
Theory QuasiTerms_PickFresh_Alpha
section ‹Availability of Fresh Variables and Alpha-Equivalence›
theory QuasiTerms_PickFresh_Alpha
imports QuasiTerms_Swap_Fresh
begin
text‹Here we define good quasi-terms and alpha-equivalence on quasi-terms,
and prove relevant properties
such as the ability to pick fresh variables for good
quasi-terms and the fact that alpha is indeed an equivalence
and is compatible with all the operators.
We do most of the work on freshness and alpha-equivalence
unsortedly, for raw quasi-terms. (And we do it in such a way that
it then applies immediately to sorted quasi-terms.)
We do need sortedness of variables (as well as a cardinality
assumption), however, for alpha-equivalence to have the desired properties.
Therefore we work in a locale.›
subsection ‹The FixVars locale›
definition var_infinite where
"var_infinite (_ :: 'var) ==
infinite (UNIV :: 'var set)"
definition var_regular where
"var_regular (_ :: 'var) ==
regular |UNIV :: 'var set|"
definition varSort_lt_var where
"varSort_lt_var (_ :: 'varSort) (_ :: 'var) ==
|UNIV :: 'varSort set| <o |UNIV :: 'var set|"
locale FixVars =
fixes dummyV :: 'var and dummyVS :: 'varSort
assumes var_infinite: "var_infinite (undefined :: 'var)"
and var_regular: "var_regular (undefined :: 'var)"
and varSort_lt_var: "varSort_lt_var (undefined :: 'varSort) (undefined :: 'var)"
context FixVars
begin
lemma varSort_lt_var_INNER:
"|UNIV :: 'varSort set| <o |UNIV :: 'var set|"
using varSort_lt_var
unfolding varSort_lt_var_def by simp
lemma varSort_le_Var:
"|UNIV :: 'varSort set| ≤o |UNIV :: 'var set|"
using varSort_lt_var_INNER ordLess_imp_ordLeq by auto
theorem var_infinite_INNER: "infinite (UNIV :: 'var set)"
using var_infinite unfolding var_infinite_def by simp
theorem var_regular_INNER: "regular |UNIV :: 'var set|"
using var_regular unfolding var_regular_def by simp
theorem infinite_var_regular_INNER:
"infinite (UNIV :: 'var set) ∧ regular |UNIV :: 'var set|"
by (simp add: var_infinite_INNER var_regular_INNER)
theorem finite_ordLess_var:
"( |S| <o |UNIV :: 'var set| ∨ finite S) = ( |S| <o |UNIV :: 'var set| )"
by (auto simp add: var_infinite_INNER finite_ordLess_infinite2)
subsection ‹Good quasi-terms›
text ‹Essentially, good quasi-term items
will be those with meaningful binders and
not too many variables. Good quasi-terms are a concept intermediate
between (raw) quasi-terms and sorted quasi-terms. This concept was chosen to be strong
enough to facilitate proofs of most of the desired properties of alpha-equivalence, avoiding,
{\em for most of the hard part of the work},
the overhead of sortedness. Since we later prove that quasi-terms
are good,
all the results are then immediately transported to a sorted setting.›
function
qGood :: "('index,'bindex,'varSort,'var,'opSym)qTerm ⇒ bool"
and
qGoodAbs :: "('index,'bindex,'varSort,'var,'opSym)qAbs ⇒ bool"
where
"qGood (qVar xs x) = True"
|
"qGood (qOp delta inp binp) =
(liftAll qGood inp ∧ liftAll qGoodAbs binp ∧
|{i. inp i ≠ None}| <o |UNIV :: 'var set| ∧
|{i. binp i ≠ None}| <o |UNIV :: 'var set| )"
|
"qGoodAbs (qAbs xs x X) = qGood X"
by (pat_completeness, auto)
termination
apply(relation qTermLess)
apply(simp_all add: qTermLess_wf)
by(auto simp add: qTermLess_def)
fun qGoodItem :: "('index,'bindex,'varSort,'var,'opSym)qTermItem ⇒ bool" where
"qGoodItem (Inl qX) = qGood qX"
|
"qGoodItem (Inr qA) = qGoodAbs qA"
lemma qSwapAll_preserves_qGoodAll1:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and zs x y
shows
"(qGood X ⟶ qGood (X #[[x ∧ y]]_zs)) ∧
(qGoodAbs A ⟶ qGoodAbs (A $[[x ∧ y]]_zs))"
apply(rule qTerm_induct[of _ _ X A])
apply(simp_all add: sw_def)
unfolding lift_def liftAll_def apply auto
apply(case_tac "inp i", auto)
apply(case_tac "binp i", auto)
proof-
fix inp::"('index,('index,'bindex,'varSort,'var,'opSym)qTerm)input" and zs xs x y
let ?K1 = "{i. ∃X. inp i = Some X}"
let ?K2 = "{i. ∃X. (case inp i of None ⇒ None | Some X ⇒ Some (X #[[x ∧ y]]_zs))
= Some X}"
assume "|?K1| <o |UNIV :: 'var set|"
moreover have "?K1 = ?K2" by(auto, case_tac "inp x", auto)
ultimately show "|?K2| <o |UNIV :: 'var set|" by simp
next
fix binp::"('bindex,('index,'bindex,'varSort,'var,'opSym)qAbs)input" and zs xs x y
let ?K1 = "{i. ∃A. binp i = Some A}"
let ?K2 = "{i. ∃A. (case binp i of None ⇒ None | Some A ⇒ Some (A $[[x ∧ y]]_zs))
= Some A}"
assume "|?K1| <o |UNIV :: 'var set|"
moreover have "?K1 = ?K2" by(auto, case_tac "binp x", auto)
ultimately show "|?K2| <o |UNIV :: 'var set|" by simp
qed
corollary qSwap_preserves_qGood1:
"qGood X ⟹ qGood (X #[[x ∧ y]]_zs)"
by(simp add: qSwapAll_preserves_qGoodAll1)
corollary qSwapAbs_preserves_qGoodAbs1:
"qGoodAbs A ⟹ qGoodAbs (A $[[x ∧ y]]_zs)"
by(simp add: qSwapAll_preserves_qGoodAll1)
lemma qSwap_preserves_qGood2:
assumes "qGood(X #[[x ∧ y]]_zs)"
shows "qGood X"
by (metis assms qSwap_involutive qSwap_preserves_qGood1)
lemma qSwapAbs_preserves_qGoodAbs2:
assumes "qGoodAbs(A $[[x ∧ y]]_zs)"
shows "qGoodAbs A"
by (metis assms qSwapAbs_preserves_qGoodAbs1 qSwapAll_involutive)
lemma qSwap_preserves_qGood: "(qGood (X #[[x ∧ y]]_zs)) = (qGood X)"
using qSwap_preserves_qGood1 qSwap_preserves_qGood2 by blast
lemma qSwapAbs_preserves_qGoodAbs:
"(qGoodAbs (A $[[x ∧ y]]_zs)) = (qGoodAbs A)"
using qSwapAbs_preserves_qGoodAbs1 qSwapAbs_preserves_qGoodAbs2 by blast
lemma qSwap_twice_preserves_qGood:
"(qGood ((X #[[x ∧ y]]_zs) #[[x' ∧ y']]_zs')) = (qGood X)"
by (simp add: qSwap_preserves_qGood)
lemma qSwapped_preserves_qGood:
"(X,Y) ∈ qSwapped ⟹ qGood Y = qGood X"
apply (induct rule: qSwapped.induct)
using qSwap_preserves_qGood by auto
lemma qGood_qTerm_templateInduct[case_names Rel Var Op Abs]:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm"
and A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and phi phiAbs rel
assumes
REL: "⋀ X Y. ⟦qGood X; (X,Y) ∈ rel⟧ ⟹ qGood Y ∧ qSkel Y = qSkel X" and
Var: "⋀ xs x. phi (qVar xs x)" and
Op: "⋀ delta inp binp. ⟦|{i. inp i ≠ None}| <o |UNIV :: 'var set|;
|{i. binp i ≠ None}| <o |UNIV :: 'var set|;
liftAll (λX. qGood X ∧ phi X) inp;
liftAll (λA. qGoodAbs A ∧ phiAbs A) binp⟧
⟹ phi (qOp delta inp binp)" and
Abs: "⋀ xs x X. ⟦qGood X; ⋀ Y. (X,Y) ∈ rel ⟹ phi Y⟧
⟹ phiAbs (qAbs xs x X)"
shows
"(qGood X ⟶ phi X) ∧ (qGoodAbs A ⟶ phiAbs A)"
apply(induct rule: qTerm_templateInduct[of "{(X,Y). qGood X ∧ (X,Y) ∈ rel}"])
using assms by (simp_all add: liftAll_def)
lemma qGood_qTerm_rawInduct[case_names Var Op Abs]:
fixes X :: "('index,'bindex,'varSort,'var,'opSym)qTerm"
and A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and phi phiAbs
assumes
Var: "⋀ xs x. phi (qVar xs x)" and
Op: "⋀ delta inp binp. ⟦|{i. inp i ≠ None}| <o |UNIV :: 'var set|;
|{i. binp i ≠ None}| <o |UNIV :: 'var set|;
liftAll (λ X. qGood X ∧ phi X) inp;
liftAll (λ A. qGoodAbs A ∧ phiAbs A) binp⟧
⟹ phi (qOp delta inp binp)" and
Abs: "⋀ xs x X. ⟦qGood X; phi X⟧ ⟹ phiAbs (qAbs xs x X)"
shows "(qGood X ⟶ phi X) ∧ (qGoodAbs A ⟶ phiAbs A)"
apply(induct rule: qGood_qTerm_templateInduct [of Id])
by(simp_all add: assms)
lemma qGood_qTerm_induct[case_names Var Op Abs]:
fixes X :: "('index,'bindex,'varSort,'var,'opSym)qTerm"
and A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and phi phiAbs
assumes
Var: "⋀ xs x. phi (qVar xs x)" and
Op: "⋀ delta inp binp. ⟦|{i. inp i ≠ None}| <o |UNIV :: 'var set|;
|{i. binp i ≠ None}| <o |UNIV :: 'var set|;
liftAll (λ X. qGood X ∧ phi X) inp;
liftAll (λ A. qGoodAbs A ∧ phiAbs A) binp⟧
⟹ phi (qOp delta inp binp)" and
Abs: "⋀ xs x X. ⟦qGood X;
⋀ Y. qGood Y ∧ qSkel Y = qSkel X ⟹ phi Y;
⋀ Y. (X,Y) ∈ qSwapped ⟹ phi Y⟧
⟹ phiAbs (qAbs xs x X)"
shows
"(qGood X ⟶ phi X) ∧ (qGoodAbs A ⟶ phiAbs A)"
apply(induct rule: qGood_qTerm_templateInduct
[of "qSwapped ∪ {(X,Y). qGood Y ∧ qSkel Y = qSkel X}"])
using qSwapped_qSkel qSwapped_preserves_qGood
by(auto simp add: assms)
text "A form specialized for mutual induction
(this time, without the cardinality hypotheses):"
lemma qGood_qTerm_induct_mutual[case_names Var1 Var2 Op1 Op2 Abs1 Abs2]:
fixes X :: "('index,'bindex,'varSort,'var,'opSym)qTerm"
and A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and phi1 phi2 phiAbs1 phiAbs2
assumes
Var1: "⋀ xs x. phi1 (qVar xs x)" and
Var2: "⋀ xs x. phi2 (qVar xs x)" and
Op1: "⋀ delta inp binp. ⟦liftAll (λ X. qGood X ∧ phi1 X) inp;
liftAll (λ A. qGoodAbs A ∧ phiAbs1 A) binp⟧
⟹ phi1 (qOp delta inp binp)" and
Op2: "⋀ delta inp binp. ⟦liftAll (λ X. qGood X ∧ phi2 X) inp;
liftAll (λ A. qGoodAbs A ∧ phiAbs2 A) binp⟧
⟹ phi2 (qOp delta inp binp)" and
Abs1: "⋀ xs x X. ⟦qGood X;
⋀ Y. qGood Y ∧ qSkel Y = qSkel X ⟹ phi1 Y;
⋀ Y. qGood Y ∧ qSkel Y = qSkel X ⟹ phi2 Y;
⋀ Y. (X,Y) ∈ qSwapped ⟹ phi1 Y;
⋀ Y. (X,Y) ∈ qSwapped ⟹ phi2 Y⟧
⟹ phiAbs1 (qAbs xs x X)" and
Abs2: "⋀ xs x X. ⟦qGood X;
⋀ Y. qGood Y ∧ qSkel Y = qSkel X ⟹ phi1 Y;
⋀ Y. qGood Y ∧ qSkel Y = qSkel X ⟹ phi2 Y;
⋀ Y. (X,Y) ∈ qSwapped ⟹ phi1 Y;
⋀ Y. (X,Y) ∈ qSwapped ⟹ phi2 Y;
phiAbs1 (qAbs xs x X)⟧
⟹ phiAbs2 (qAbs xs x X)"
shows
"(qGood X ⟶ (phi1 X ∧ phi2 X)) ∧
(qGoodAbs A ⟶ (phiAbs1 A ∧ phiAbs2 A))"
apply(induct rule: qGood_qTerm_induct[of _ _ X A])
by(auto simp add: assms liftAll_and)
subsection ‹The ability to pick fresh variables›
lemma single_non_qAFreshAll_ordLess_var:
fixes X :: "('index,'bindex,'varSort,'var,'opSym)qTerm"
and A::"('index,'bindex,'varSort,'var,'opSym)qAbs"
shows
"(qGood X ⟶ |{x. ¬ qAFresh xs x X}| <o |UNIV :: 'var set| ) ∧
(qGoodAbs A ⟶ |{x. ¬ qAFreshAbs xs x A}| <o |UNIV :: 'var set| )"
proof(induct rule: qGood_qTerm_rawInduct)
case (Var xs x)
then show ?case using infinite_var_regular_INNER by simp
next
case (Op delta inp binp)
let ?Left = "{x. ¬ qAFresh xs x (qOp delta inp binp)}"
obtain J where J_def: "J = {i. ∃ X. inp i = Some X}" by blast
let ?S = "⋃ i ∈ J. {x. ∃ X. inp i = Some X ∧ ¬ qAFresh xs x X}"
{fix i
obtain K where K_def: "K = {X. inp i = Some X}" by blast
have "finite K" unfolding K_def by (cases "inp i", auto)
hence "|K| <o |UNIV :: 'var set|" using var_infinite_INNER finite_ordLess_infinite2 by auto
moreover have "∀ X ∈ K. |{x. ¬ qAFresh xs x X}| <o |UNIV :: 'var set|"
unfolding K_def using Op unfolding liftAll_def by simp
ultimately have "|⋃ X ∈ K. {x. ¬ qAFresh xs x X}| <o |UNIV :: 'var set|"
using var_regular_INNER by (simp add: regular_UNION)
moreover
have "{x. ∃X. inp i = Some X ∧ ¬ qAFresh xs x X} =
(⋃ X ∈ K. {x. ¬ qAFresh xs x X})" unfolding K_def by blast
ultimately
have "|{x. ∃X. inp i = Some X ∧ ¬ qAFresh xs x X}| <o |UNIV :: 'var set|"
by simp
}
moreover have "|J| <o |UNIV :: 'var set|" unfolding J_def
using Op unfolding liftAll_def by simp
ultimately
have 1: "|?S| <o |UNIV :: 'var set|"
using var_regular_INNER by (simp add: regular_UNION)
obtain Ja where Ja_def: "Ja = {i. ∃ A. binp i = Some A}" by blast
let ?Sa = "⋃ i ∈ Ja. {x. ∃ A. binp i = Some A ∧ ¬ qAFreshAbs xs x A}"
{fix i
obtain K where K_def: "K = {A. binp i = Some A}" by blast
have "finite K" unfolding K_def by (cases "binp i", auto)
hence "|K| <o |UNIV :: 'var set|" using var_infinite_INNER finite_ordLess_infinite2 by auto
moreover have "∀ A ∈ K. |{x. ¬ qAFreshAbs xs x A}| <o |UNIV :: 'var set|"
unfolding K_def using Op unfolding liftAll_def by simp
ultimately have "|⋃ A ∈ K. {x. ¬ qAFreshAbs xs x A}| <o |UNIV :: 'var set|"
using var_regular_INNER by (simp add: regular_UNION)
moreover
have "{x. ∃A. binp i = Some A ∧ ¬ qAFreshAbs xs x A} =
(⋃ A ∈ K. {x. ¬ qAFreshAbs xs x A})" unfolding K_def by blast
ultimately
have "|{x. ∃A. binp i = Some A ∧ ¬ qAFreshAbs xs x A}| <o |UNIV :: 'var set|"
by simp
}
moreover have "|Ja| <o |UNIV :: 'var set|"
unfolding Ja_def using Op unfolding liftAll_def by simp
ultimately have "|?Sa| <o |UNIV :: 'var set|"
using var_regular_INNER by (simp add: regular_UNION)
with 1 have "|?S Un ?Sa| <o |UNIV :: 'var set|"
using var_infinite_INNER card_of_Un_ordLess_infinite by auto
moreover have "?Left = ?S Un ?Sa"
by (auto simp: J_def Ja_def liftAll_def )
ultimately show ?case by simp
next
case (Abs xsa x X)
let ?Left = "{xa. xs = xsa ∧ xa = x ∨ ¬ qAFresh xs xa X}"
have "|{x}| <o |UNIV :: 'var set|" by (auto simp add: var_infinite_INNER)
hence "|{x} ∪ {x. ¬ qAFresh xs x X}| <o |UNIV :: 'var set|"
using Abs var_infinite_INNER card_of_Un_ordLess_infinite by blast
moreover
{have "?Left ⊆ {x} ∪ {x. ¬ qAFresh xs x X}" by blast
hence "|?Left| ≤o |{x} ∪ {x. ¬ qAFresh xs x X}|" using card_of_mono1 by auto
}
ultimately show ?case using ordLeq_ordLess_trans by auto
qed
corollary single_non_qAFresh_ordLess_var:
"qGood X ⟹ |{x. ¬ qAFresh xs x X}| <o |UNIV :: 'var set|"
by(simp add: single_non_qAFreshAll_ordLess_var)
corollary single_non_qAFreshAbs_ordLess_var:
"qGoodAbs A ⟹ |{x. ¬ qAFreshAbs xs x A}| <o |UNIV :: 'var set|"
by(simp add: single_non_qAFreshAll_ordLess_var)
lemma single_non_qFresh_ordLess_var:
assumes "qGood X"
shows "|{x. ¬ qFresh xs x X}| <o |UNIV :: 'var set|"
using qAFresh_imp_qFresh card_of_mono1 single_non_qAFresh_ordLess_var
ordLeq_ordLess_trans by (metis Collect_mono assms)
lemma single_non_qFreshAbs_ordLess_var:
assumes "qGoodAbs A"
shows "|{x. ¬ qFreshAbs xs x A}| <o |UNIV :: 'var set|"
using qAFreshAll_imp_qFreshAll card_of_mono1 single_non_qAFreshAbs_ordLess_var
ordLeq_ordLess_trans by (metis Collect_mono assms)
lemma non_qAFresh_ordLess_var:
assumes GOOD: "∀ X ∈ XS. qGood X" and Var: "|XS| <o |UNIV :: 'var set|"
shows "|{x| x X. X ∈ XS ∧ ¬ qAFresh xs x X}| <o |UNIV :: 'var set|"
proof-
define K and F where "K ≡ {x| x X. X ∈ XS ∧ ¬ qAFresh xs x X}"
and "F ≡ (λ X. {x. X ∈ XS ∧ ¬ qAFresh xs x X})"
have "K = (⋃ X ∈ XS. F X)" unfolding K_def F_def by auto
moreover have "∀ X ∈ XS. |F X| <o |UNIV :: 'var set|"
unfolding F_def using GOOD single_non_qAFresh_ordLess_var by auto
ultimately have "|K| <o |UNIV :: 'var set|" using var_regular_INNER Var
by(auto simp add: regular_UNION)
thus ?thesis unfolding K_def .
qed
lemma non_qAFresh_or_in_ordLess_var:
assumes Var: "|V| <o |UNIV :: 'var set|" and "|XS| <o |UNIV :: 'var set|" and "∀ X ∈ XS. qGood X"
shows "|{x| x X. (x ∈ V ∨ (X ∈ XS ∧ ¬ qAFresh xs x X))}| <o |UNIV :: 'var set|"
proof-
define J and K where "J ≡ {x| x X. (x ∈ V ∨ (X ∈ XS ∧ ¬ qAFresh xs x X))}"
and "K ≡ {x| x X. X ∈ XS ∧ ¬ qAFresh xs x X}"
have "J ⊆ K ∪ V" unfolding J_def K_def by auto
hence "|J| ≤o |K ∪ V|" using card_of_mono1 by auto
moreover
{have "|K| <o |UNIV :: 'var set|" unfolding K_def using assms non_qAFresh_ordLess_var by auto
hence "|K ∪ V| <o |UNIV :: 'var set|" using Var var_infinite_INNER card_of_Un_ordLess_infinite by auto
}
ultimately have "|J| <o |UNIV :: 'var set|" using ordLeq_ordLess_trans by blast
thus ?thesis unfolding J_def .
qed
lemma obtain_set_qFresh_card_of:
assumes "|V| <o |UNIV :: 'var set|" and "|XS| <o |UNIV :: 'var set|" and "∀ X ∈ XS. qGood X"
shows "∃ W. infinite W ∧ W Int V = {} ∧
(∀ x ∈ W. ∀ X ∈ XS. qAFresh xs x X ∧ qFresh xs x X)"
proof-
define J where "J ≡ {x| x X. (x ∈ V ∨ (X ∈ XS ∧ ¬ qAFresh xs x X))}"
let ?W = "UNIV - J"
have "|J| <o |UNIV :: 'var set|"
unfolding J_def using assms non_qAFresh_or_in_ordLess_var by auto
hence "infinite ?W" using var_infinite_INNER subset_ordLeq_diff_infinite[of _ J] by auto
moreover
have "?W ∩ V = {} ∧ (∀ x ∈ ?W. ∀ X ∈ XS. qAFresh xs x X ∧ qFresh xs x X)"
unfolding J_def using qAFresh_imp_qFresh by fastforce
ultimately show ?thesis by blast
qed
lemma obtain_set_qFresh:
assumes "finite V ∨ |V| <o |UNIV :: 'var set|" and "finite XS ∨ |XS| <o |UNIV :: 'var set|" and
"∀ X ∈ XS. qGood X"
shows "∃ W. infinite W ∧ W Int V = {} ∧
(∀ x ∈ W. ∀ X ∈ XS. qAFresh xs x X ∧ qFresh xs x X)"
using assms
by(fastforce simp add: var_infinite_INNER obtain_set_qFresh_card_of)
lemma obtain_qFresh_card_of:
assumes "|V| <o |UNIV :: 'var set|" and "|XS| <o |UNIV :: 'var set|" and "∀ X ∈ XS. qGood X"
shows "∃ x. x ∉ V ∧ (∀ X ∈ XS. qAFresh xs x X ∧ qFresh xs x X)"
proof-
obtain W where "infinite W" and
*: "W ∩ V = {} ∧ (∀ x ∈ W. ∀ X ∈ XS. qAFresh xs x X ∧ qFresh xs x X)"
using assms obtain_set_qFresh_card_of by blast
then obtain x where "x ∈ W" using infinite_imp_nonempty by fastforce
thus ?thesis using * by auto
qed
lemma obtain_qFresh:
assumes "finite V ∨ |V| <o |UNIV :: 'var set|" and "finite XS ∨ |XS| <o |UNIV :: 'var set|" and
"∀ X ∈ XS. qGood X"
shows "∃ x. x ∉ V ∧ (∀ X ∈ XS. qAFresh xs x X ∧ qFresh xs x X)"
using assms
by(fastforce simp add: var_infinite_INNER obtain_qFresh_card_of)
definition pickQFresh where
"pickQFresh xs V XS ==
SOME x. x ∉ V ∧ (∀ X ∈ XS. qAFresh xs x X ∧ qFresh xs x X)"
lemma pickQFresh_card_of:
assumes "|V| <o |UNIV :: 'var set|" and "|XS| <o |UNIV :: 'var set|" and "∀ X ∈ XS. qGood X"
shows "pickQFresh xs V XS ∉ V ∧
(∀ X ∈ XS. qAFresh xs (pickQFresh xs V XS) X ∧ qFresh xs (pickQFresh xs V XS) X)"
unfolding pickQFresh_def apply(rule someI_ex)
using assms obtain_qFresh_card_of by blast
lemma pickQFresh:
assumes "finite V ∨ |V| <o |UNIV :: 'var set|" and "finite XS ∨ |XS| <o |UNIV :: 'var set|" and
"∀ X ∈ XS. qGood X"
shows "pickQFresh xs V XS ∉ V ∧
(∀ X ∈ XS. qAFresh xs (pickQFresh xs V XS) X ∧ qFresh xs (pickQFresh xs V XS) X)"
unfolding pickQFresh_def apply(rule someI_ex)
using assms by(auto simp add: obtain_qFresh)
end
subsection ‹Alpha-equivalence›
subsubsection ‹Definition›
definition aux_alpha_ignoreSecond ::
"('index,'bindex,'varSort,'var,'opSym)qTerm * ('index,'bindex,'varSort,'var,'opSym)qTerm +
('index,'bindex,'varSort,'var,'opSym)qAbs * ('index,'bindex,'varSort,'var,'opSym)qAbs
⇒
('index,'bindex,'varSort,'var,'opSym)qTermItem"
where
"aux_alpha_ignoreSecond K ==
case K of Inl(X,Y) ⇒ termIn X
|Inr(A,B) ⇒ absIn A"
lemma aux_alpha_ignoreSecond_qTermLessQSwapped_wf:
"wf(inv_image qTermQSwappedLess aux_alpha_ignoreSecond)"
using qTermQSwappedLess_wf wf_inv_image by auto
function
alpha and alphaAbs
where
"alpha (qVar xs x) (qVar xs' x') ⟷ xs = xs' ∧ x = x'"
|
"alpha (qOp delta inp binp) (qOp delta' inp' binp') ⟷
delta = delta' ∧ sameDom inp inp' ∧ sameDom binp binp' ∧
liftAll2 alpha inp inp' ∧
liftAll2 alphaAbs binp binp'"
|
"alpha (qVar xs x) (qOp delta' inp' binp') ⟷ False"
|
"alpha (qOp delta inp binp) (qVar xs' x') ⟷ False"
|
"alphaAbs (qAbs xs x X) (qAbs xs' x' X') ⟷
xs = xs' ∧
(∃ y. y ∉ {x,x'} ∧ qAFresh xs y X ∧ qAFresh xs' y X' ∧
alpha (X #[[y ∧ x]]_xs) (X' #[[y ∧ x']]_xs'))"
by(pat_completeness, auto)
termination
apply(relation "inv_image qTermQSwappedLess aux_alpha_ignoreSecond")
apply(simp add: aux_alpha_ignoreSecond_qTermLessQSwapped_wf)
by(auto simp add: qTermQSwappedLess_def qTermLess_modulo_def
aux_alpha_ignoreSecond_def qSwap_qSwapped)
abbreviation alpha_abbrev (infix "#=" 50) where "X #= Y ≡ alpha X Y"
abbreviation alphaAbs_abbrev (infix "$=" 50) where "A $= B ≡ alphaAbs A B"
context FixVars
begin
subsubsection ‹Simplification and elimination rules›
lemma alpha_inp_None:
"qOp delta inp binp #= qOp delta' inp' binp' ⟹
(inp i = None) = (inp' i = None)"
by(auto simp add: sameDom_def)
lemma alpha_binp_None:
"qOp delta inp binp #= qOp delta' inp' binp' ⟹
(binp i = None) = (binp' i = None)"
by(auto simp add: sameDom_def)
lemma qVar_alpha_iff:
"qVar xs x #= X' ⟷ X' = qVar xs x"
by(cases X', auto)
lemma alpha_qVar_iff:
"X #= qVar xs' x' ⟷ X = qVar xs' x'"
by(cases X, auto)
lemma qOp_alpha_iff:
"qOp delta inp binp #= X' ⟷
(∃ inp' binp'.
X' = qOp delta inp' binp' ∧ sameDom inp inp' ∧ sameDom binp binp' ∧
liftAll2 (λY Y'. Y #= Y') inp inp' ∧
liftAll2 (λA A'. A $= A') binp binp')"
by(cases X') auto
lemma alpha_qOp_iff:
"X #= qOp delta' inp' binp' ⟷
(∃ inp binp. X = qOp delta' inp binp ∧ sameDom inp inp' ∧ sameDom binp binp' ∧
liftAll2 (λY Y'. Y #= Y') inp inp' ∧
liftAll2 (λA A'. A $= A') binp binp')"
by(cases X) auto
lemma qAbs_alphaAbs_iff:
"qAbs xs x X $= A' ⟷
(∃ x' y X'. A' = qAbs xs x' X' ∧
y ∉ {x,x'} ∧ qAFresh xs y X ∧ qAFresh xs y X' ∧
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs))"
by(cases A') auto
lemma alphaAbs_qAbs_iff:
"A $= qAbs xs' x' X' ⟷
(∃ x y X. A = qAbs xs' x X ∧
y ∉ {x,x'} ∧ qAFresh xs' y X ∧ qAFresh xs' y X' ∧
(X #[[y ∧ x]]_xs') #= (X' #[[y ∧ x']]_xs'))"
by(cases A) auto
subsubsection ‹Basic properties›
text‹In a nutshell: ``alpha" is included in the kernel of ``qSkel", is
an equivalence on good quasi-terms, preserves goodness,
and all operators and relations (except ``qAFresh") preserve alpha.›
lemma alphaAll_qSkelAll:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs"
shows
"(∀ X'. X #= X' ⟶ qSkel X = qSkel X') ∧
(∀ A'. A $= A' ⟶ qSkelAbs A = qSkelAbs A')"
proof(induction rule: qTerm_induct)
case (Var xs x)
then show ?case unfolding qVar_alpha_iff by simp
next
case (Op delta inp binp)
show ?case proof safe
fix X'
assume "qOp delta inp binp #= X'"
then obtain inp' binp' where X'eq: "X' = qOp delta inp' binp'" and
1: "sameDom inp inp' ∧ sameDom binp binp'" and
2: "liftAll2 (λ Y Y'. Y #= Y') inp inp' ∧
liftAll2 (λ A A'. A $= A') binp binp'"
unfolding qOp_alpha_iff by auto
from Op.IH 1 2
show "qSkel (qOp delta inp binp) = qSkel X'"
by (simp add: X'eq fun_eq_iff option.case_eq_if
lift_def liftAll_def sameDom_def liftAll2_def)
qed
next
case (Abs xs x X)
show ?case
proof safe
fix A' assume "qAbs xs x X $= A'"
then obtain X' x' y where A'eq: "A' = qAbs xs x' X'" and
*: "(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)" unfolding qAbs_alphaAbs_iff by auto
moreover have "(X, X #[[y ∧ x]]_xs) ∈ qSwapped" using qSwap_qSwapped by fastforce
ultimately have "qSkel(X #[[y ∧ x]]_xs) = qSkel(X' #[[y ∧ x']]_xs)"
using Abs.IH by blast
hence "qSkel X = qSkel X'" by(auto simp add: qSkel_qSwap)
thus "qSkelAbs (qAbs xs x X) = qSkelAbs A'" unfolding A'eq by simp
qed
qed
corollary alpha_qSkel:
fixes X X' :: "('index,'bindex,'varSort,'var,'opSym)qTerm"
shows "X #= X' ⟹ qSkel X = qSkel X'"
by(simp add: alphaAll_qSkelAll)
text‹Symmetry of alpha is a property that holds for arbitrary
(not necessarily good) quasi-terms.›
lemma alphaAll_sym:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs"
shows
"(∀ X'. X #= X' ⟶ X' #= X) ∧ (∀ A'. A $= A' ⟶ A' $= A)"
proof(induction rule: qTerm_induct)
case (Var xs x)
then show ?case unfolding qVar_alpha_iff by simp
next
case (Op delta inp binp)
show ?case proof safe
fix X' assume "qOp delta inp binp #= X'"
then obtain inp' binp' where X': "X' = qOp delta inp' binp'" and
1: "sameDom inp inp' ∧ sameDom binp binp'"
and 2: "liftAll2 (λY Y'. Y #= Y') inp inp' ∧
liftAll2 (λA A'. A $= A') binp binp'"
unfolding qOp_alpha_iff by auto
thus "X' #= qOp delta inp binp"
unfolding X' using Op.IH 1 2
by (auto simp add: fun_eq_iff option.case_eq_if
lift_def liftAll_def sameDom_def liftAll2_def)
qed
next
case (Abs xs x X)
show ?case proof safe
fix A' assume "qAbs xs x X $= A'"
then obtain x' y X' where
1: "A' = qAbs xs x' X' ∧ y ∉ {x, x'} ∧ qAFresh xs y X ∧ qAFresh xs y X'" and
"(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)"
unfolding qAbs_alphaAbs_iff by auto
moreover have "(X, X #[[y ∧ x]]_xs) ∈ qSwapped" by (simp add: qSwap_qSwapped)
ultimately have "(X' #[[y ∧ x']]_xs) #= (X #[[y ∧ x]]_xs)" using Abs.IH by simp
thus "A' $= qAbs xs x X" using 1 by auto
qed
qed
corollary alpha_sym:
fixes X X' :: "('index,'bindex,'varSort,'var,'opSym)qTerm"
shows "X #= X' ⟹ X' #= X"
by(simp add: alphaAll_sym)
corollary alphaAbs_sym:
fixes A A' ::"('index,'bindex,'varSort,'var,'opSym)qAbs"
shows "A $= A' ⟹ A' $= A"
by(simp add: alphaAll_sym)
text‹Reflexivity does not hold for arbitrary quasi-terms, but onl;y for good
ones. Indeed, the proof requires picking a fresh variable,
guaranteed to be possible only if the quasi-term is good.›
lemma alphaAll_refl:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs"
shows
"(qGood X ⟶ X #= X) ∧ (qGoodAbs A ⟶ A $= A)"
apply(rule qGood_qTerm_induct, simp_all)
unfolding liftAll_def sameDom_def liftAll2_def apply auto
proof-
fix xs x X
assume "qGood X" and
IH: "⋀Y. (X,Y) ∈ qSwapped ⟹ Y #= Y"
then obtain y where 1: "y ≠ x ∧ qAFresh xs y X"
using obtain_qFresh[of "{x}" "{X}"] by auto
hence "(X, X #[[y ∧ x]]_xs) ∈ qSwapped" using qSwap_qSwapped by auto
hence "(X #[[y ∧ x]]_xs) #= (X #[[y ∧ x]]_xs)" using IH by simp
thus "∃y. y ≠ x ∧ qAFresh xs y X ∧ (X #[[y ∧ x]]_xs) #= (X #[[y ∧ x]]_xs)"
using 1 by blast
qed
corollary alpha_refl:
fixes X :: "('index,'bindex,'varSort,'var,'opSym)qTerm"
shows "qGood X ⟹ X #= X"
by(simp add: alphaAll_refl)
corollary alphaAbs_refl:
fixes A ::"('index,'bindex,'varSort,'var,'opSym)qAbs"
shows "qGoodAbs A ⟹ A $= A"
by(simp add: alphaAll_refl)
lemma alphaAll_preserves_qGoodAll1:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs"
shows
"(qGood X ⟶ (∀ X'. X #= X' ⟶ qGood X')) ∧
(qGoodAbs A ⟶ (∀ A'. A $= A' ⟶ qGoodAbs A'))"
apply(rule qTerm_induct, auto)
unfolding qVar_alpha_iff apply(auto)
proof-
fix delta inp binp X'
assume
IH1: "liftAll (λY. qGood Y ⟶ (∀Y'. Y #= Y' ⟶ qGood Y')) inp"
and IH2: "liftAll (λA. qGoodAbs A ⟶ (∀A'. A $= A' ⟶ qGoodAbs A')) binp"
and *: "liftAll qGood inp" "liftAll qGoodAbs binp"
and **: "|{i. ∃Y. inp i = Some Y}| <o |UNIV :: 'var set|"
"|{i. ∃A. binp i = Some A}| <o |UNIV :: 'var set|"
and "qOp delta inp binp #= X'"
then obtain inp' binp' where
X'eq: "X' = qOp delta inp' binp'" and
2: "sameDom inp inp' ∧ sameDom binp binp'" and
3: "liftAll2 (λY Y'. Y #= Y') inp inp' ∧
liftAll2 (λA A'. A $= A') binp binp'"
unfolding qOp_alpha_iff by auto
show "qGood X'"
unfolding X'eq apply simp unfolding liftAll_def apply auto
proof-
fix i Y' assume inp': "inp' i = Some Y'"
then obtain Y where inp: "inp i = Some Y"
using 2 unfolding sameDom_def by fastforce
hence "Y #= Y'" using inp' 3 unfolding liftAll2_def by blast
moreover have "qGood Y" using * inp unfolding liftAll_def by simp
ultimately show "qGood Y'" using IH1 inp unfolding liftAll_def by blast
next
fix i A' assume binp': "binp' i = Some A'"
then obtain A where binp: "binp i = Some A"
using 2 unfolding sameDom_def by fastforce
hence "A $= A'" using binp' 3 unfolding liftAll2_def by blast
moreover have "qGoodAbs A" using * binp unfolding liftAll_def by simp
ultimately show "qGoodAbs A'" using IH2 binp unfolding liftAll_def by blast
next
have "{i. ∃Y'. inp' i = Some Y'} = {i. ∃Y. inp i = Some Y}"
using 2 unfolding sameDom_def by force
thus "|{i. ∃Y'. inp' i = Some Y'}| <o |UNIV :: 'var set|" using ** by simp
next
have "{i. ∃A'. binp' i = Some A'} = {i. ∃A. binp i = Some A}"
using 2 unfolding sameDom_def by force
thus "|{i. ∃A'. binp' i = Some A'}| <o |UNIV :: 'var set|" using ** by simp
qed
next
fix xs x X A'
assume IH: "⋀Y. (X,Y) ∈ qSwapped ⟹ qGood Y ⟶ (∀X'. Y #= X' ⟶ qGood X')"
and *: "qGood X" and "qAbs xs x X $= A'"
then obtain x' y X' where "A' = qAbs xs x' X'" and
1: "(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)"
unfolding qAbs_alphaAbs_iff by auto
thus "qGoodAbs A'"
proof(auto)
have "(X, X #[[y ∧ x]]_xs) ∈ qSwapped" by(auto simp add: qSwap_qSwapped)
moreover have "qGood(X #[[y ∧ x]]_xs)" using * qSwap_preserves_qGood by auto
ultimately have "qGood(X' #[[y ∧ x']]_xs)" using 1 IH by auto
thus "qGood X'" using * qSwap_preserves_qGood by auto
qed
qed
corollary alpha_preserves_qGood1:
"⟦X #= X'; qGood X⟧ ⟹ qGood X'"
using alphaAll_preserves_qGoodAll1 by blast
corollary alphaAbs_preserves_qGoodAbs1:
"⟦A $= A'; qGoodAbs A⟧ ⟹ qGoodAbs A'"
using alphaAll_preserves_qGoodAll1 by blast
lemma alpha_preserves_qGood2:
"⟦X #= X'; qGood X'⟧ ⟹ qGood X"
using alpha_sym alpha_preserves_qGood1 by blast
lemma alphaAbs_preserves_qGoodAbs2:
"⟦A $= A'; qGoodAbs A'⟧ ⟹ qGoodAbs A"
using alphaAbs_sym alphaAbs_preserves_qGoodAbs1 by blast
lemma alpha_preserves_qGood:
"X #= X' ⟹ qGood X = qGood X'"
using alpha_preserves_qGood1 alpha_preserves_qGood2 by blast
lemma alphaAbs_preserves_qGoodAbs:
"A $= A' ⟹ qGoodAbs A = qGoodAbs A'"
using alphaAbs_preserves_qGoodAbs1 alphaAbs_preserves_qGoodAbs2 by blast
lemma alpha_qSwap_preserves_qGood1:
assumes ALPHA: "(X #[[y ∧ x]]_zs) #= (X' #[[y' ∧ x']]_zs')" and
GOOD: "qGood X"
shows "qGood X'"
proof-
have "qGood(X #[[y ∧ x]]_zs)" using GOOD qSwap_preserves_qGood by auto
hence "qGood (X' #[[y' ∧ x']]_zs')" using ALPHA alpha_preserves_qGood by auto
thus "qGood X'" using qSwap_preserves_qGood by auto
qed
lemma alpha_qSwap_preserves_qGood2:
assumes ALPHA: "(X #[[y ∧ x]]_zs) #= (X' #[[y' ∧ x']]_zs')" and
GOOD': "qGood X'"
shows "qGood X"
proof-
have "qGood(X' #[[y' ∧ x']]_zs')" using GOOD' qSwap_preserves_qGood by auto
hence "qGood (X #[[y ∧ x]]_zs)" using ALPHA alpha_preserves_qGood by auto
thus "qGood X" using qSwap_preserves_qGood by auto
qed
lemma alphaAbs_qSwapAbs_preserves_qGoodAbs2:
assumes ALPHA: "(A $[[y ∧ x]]_zs) $= (A' $[[y' ∧ x']]_zs')" and
GOOD': "qGoodAbs A'"
shows "qGoodAbs A"
proof-
have "qGoodAbs(A' $[[y' ∧ x']]_zs')" using GOOD' qSwapAbs_preserves_qGoodAbs by auto
hence "qGoodAbs (A $[[y ∧ x]]_zs)" using ALPHA alphaAbs_preserves_qGoodAbs by auto
thus "qGoodAbs A" using qSwapAbs_preserves_qGoodAbs by auto
qed
lemma alpha_qSwap_preserves_qGood:
assumes ALPHA: "(X #[[y ∧ x]]_zs) #= (X' #[[y' ∧ x']]_zs')"
shows "qGood X = qGood X'"
using assms alpha_qSwap_preserves_qGood1
alpha_qSwap_preserves_qGood2 by auto
lemma qSwapAll_preserves_alphaAll:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and z1 z2 zs
shows
"(qGood X ⟶ (∀ X' zs z1 z2. X #= X' ⟶
(X #[[z1 ∧ z2]]_zs) #= (X' #[[z1 ∧ z2]]_zs))) ∧
(qGoodAbs A ⟶ (∀ A' zs z1 z2. A $= A' ⟶
(A $[[z1 ∧ z2]]_zs) $= (A' $[[z1 ∧ z2]]_zs)))"
proof(induction rule: qGood_qTerm_induct)
case (Var xs x)
then show ?case unfolding qVar_alpha_iff by simp
next
case (Op delta inp binp)
show ?case proof safe
fix X' zs z1 z2
assume "qOp delta inp binp #= X'" term X' term binp
then obtain inp' binp' where X'eq: "X' = qOp delta inp' binp'" and
1: "sameDom inp inp' ∧ sameDom binp binp'"
and 2: "liftAll2 (λ Y Y'. Y #= Y') inp inp' ∧
liftAll2 (λ A A'. A $= A') binp binp'"
unfolding qOp_alpha_iff by auto
thus "((qOp delta inp binp) #[[z1 ∧ z2]]_zs) #= (X' #[[z1 ∧ z2]]_zs)"
unfolding X'eq using Op.IH
by (auto simp add: fun_eq_iff option.case_eq_if
lift_def liftAll_def sameDom_def liftAll2_def)
qed
next
case (Abs xs x X)
show ?case proof safe
fix A' zs z1 z2 assume "qAbs xs x X $= A'"
then obtain x' y X' where A': "A' = qAbs xs x' X'" and
y_not: "y ∉ {x, x'}" and y_fresh: "qAFresh xs y X ∧ qAFresh xs y X'" and
alpha: "(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)"
unfolding qAbs_alphaAbs_iff by auto
hence goodX': "qGood X'" using ‹qGood X› alpha_qSwap_preserves_qGood by fastforce
obtain u where u_notin: "u ∉ {x,x',z1,z2,y}" and
u_freshXX': "qAFresh xs u X ∧ qAFresh xs u X'"
using ‹qGood X› goodX' obtain_qFresh[of "{x,x',z1,z2,y}" "{X,X'}"] by auto
hence u_not: "u ≠ (x @xs[z1 ∧ z2]_zs) ∧ u ≠ (x' @xs[z1 ∧ z2]_zs)"
unfolding sw_def using u_notin by auto
have u_fresh: "qAFresh xs u (X #[[z1 ∧ z2]]_zs) ∧ qAFresh xs u (X' #[[z1 ∧ z2]]_zs)"
using u_freshXX' u_notin by(auto simp add: qSwap_preserves_qAFresh_distinct)
have "((X #[[z1 ∧ z2]]_zs) #[[u ∧ (x @xs[z1 ∧ z2]_zs)]]_xs) =
(((X #[[y ∧ x]]_xs) #[[u ∧ y]]_xs) #[[z1 ∧ z2]]_zs)"
using y_fresh u_freshXX' u_notin by (simp add: qSwap_3commute)
moreover
{have 1: "(X, X #[[y ∧ x]]_xs) ∈ qSwapped" by(simp add: qSwap_qSwapped)
hence "((X #[[y ∧ x]]_xs) #[[u ∧ y]]_xs) #= ((X' #[[y ∧ x']]_xs) #[[u ∧ y]]_xs)"
using alpha Abs.IH by auto
moreover have "(X, (X #[[y ∧ x]]_xs) #[[u ∧ y]]_xs) ∈ qSwapped"
using 1 by(auto simp add: qSwapped.Swap)
ultimately have "(((X #[[y ∧ x]]_xs) #[[u ∧ y]]_xs) #[[z1 ∧ z2]]_zs) #=
(((X' #[[y ∧ x']]_xs) #[[u ∧ y]]_xs) #[[z1 ∧ z2]]_zs)"
using Abs.IH by auto
}
moreover
have "(((X' #[[y ∧ x']]_xs) #[[u ∧ y]]_xs) #[[z1 ∧ z2]]_zs) =
((X' #[[z1 ∧ z2]]_zs) #[[u ∧ (x' @xs[z1 ∧ z2]_zs)]]_xs)"
using y_fresh u_freshXX' u_notin by (auto simp add: qSwap_3commute)
ultimately have "((X #[[z1 ∧ z2]]_zs) #[[u ∧ (x @xs[z1 ∧ z2]_zs)]]_xs) #=
((X' #[[z1 ∧ z2]]_zs) #[[u ∧ (x' @xs[z1 ∧ z2]_zs)]]_xs)" by simp
thus "((qAbs xs x X) $[[z1 ∧ z2]]_zs) $= (A' $[[z1 ∧ z2]]_zs)"
unfolding A' using u_not u_fresh by auto
qed
qed
corollary qSwap_preserves_alpha:
assumes "qGood X ∨ qGood X'" and "X #= X'"
shows "(X #[[z1 ∧ z2]]_zs) #= (X' #[[z1 ∧ z2]]_zs)"
using assms alpha_preserves_qGood qSwapAll_preserves_alphaAll by blast
corollary qSwapAbs_preserves_alphaAbs:
assumes "qGoodAbs A ∨ qGoodAbs A'" and "A $= A'"
shows "(A $[[z1 ∧ z2]]_zs) $= (A' $[[z1 ∧ z2]]_zs)"
using assms alphaAbs_preserves_qGoodAbs qSwapAll_preserves_alphaAll by blast
lemma qSwap_twice_preserves_alpha:
assumes "qGood X ∨ qGood X'" and "X #= X'"
shows "((X #[[z1 ∧ z2]]_zs) #[[u1 ∧ u2]]_us) #= ((X' #[[z1 ∧ z2]]_zs) #[[u1 ∧ u2]]_us)"
by (simp add: assms qSwap_preserves_alpha qSwap_preserves_qGood)
lemma alphaAll_trans:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs"
shows
"(qGood X ⟶ (∀ X' X''. X #= X' ∧ X' #= X'' ⟶ X #= X'')) ∧
(qGoodAbs A ⟶ (∀ A' A''. A $= A' ∧ A' $= A'' ⟶ A $= A''))"
proof(induction rule: qGood_qTerm_induct)
case (Var xs x)
then show ?case by (simp add: qVar_alpha_iff)
next
case (Op delta inp binp)
show ?case proof safe
fix X' X'' assume "qOp delta inp binp #= X'" and *: "X' #= X''"
then obtain inp' binp' where
1: "X' = qOp delta inp' binp'" and
2: "sameDom inp inp' ∧ sameDom binp binp'" and
3: "liftAll2 (λY Y'. Y #= Y') inp inp' ∧
liftAll2 (λA A'. A $= A') binp binp'"
unfolding qOp_alpha_iff by auto
obtain inp'' binp'' where
11: "X'' = qOp delta inp'' binp''" and
22: "sameDom inp' inp'' ∧ sameDom binp' binp''" and
33: "liftAll2 (λY' Y''. Y' #= Y'') inp' inp'' ∧
liftAll2 (λA' A''. A' $= A'') binp' binp''"
using * unfolding 1 unfolding qOp_alpha_iff by auto
have "liftAll2 (#=) inp inp''" unfolding liftAll2_def proof safe
fix i Y Y''
assume inp: "inp i = Some Y" and inp'': "inp'' i = Some Y''"
then obtain Y' where inp': "inp' i = Some Y'"
using 2 unfolding sameDom_def by force
hence "Y #= Y'" using inp 3 unfolding liftAll2_def by blast
moreover have "Y' #= Y''" using inp' inp'' 33 unfolding liftAll2_def by blast
ultimately show "Y #= Y''" using inp Op.IH unfolding liftAll_def by blast
qed
moreover have "liftAll2 ($=) binp binp''" unfolding liftAll2_def proof safe
fix i A A''
assume binp: "binp i = Some A" and binp'': "binp'' i = Some A''"
then obtain A' where binp': "binp' i = Some A'"
using 2 unfolding sameDom_def by force
hence "A $= A'" using binp 3 unfolding liftAll2_def by blast
moreover have "A' $= A''" using binp' binp'' 33 unfolding liftAll2_def by blast
ultimately show "A $= A''" using binp Op.IH unfolding liftAll_def by blast
qed
ultimately show "qOp delta inp binp #= X''"
by (simp add: 11 2 22 sameDom_trans[of inp inp'] sameDom_trans[of binp binp'])
qed
next
case (Abs xs x X)
show ?case proof safe
fix A' A''
assume "qAbs xs x X $= A'" and *: "A' $= A''"
then obtain x' y X' where A': "A' = qAbs xs x' X'" and y_not: "y ∉ {x, x'}" and
y_fresh: "qAFresh xs y X ∧ qAFresh xs y X'" and
alpha: "(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)"
unfolding qAbs_alphaAbs_iff by auto
obtain x'' z X'' where A'': "A'' = qAbs xs x'' X''" and z_not: "z ∉ {x', x''}" and
z_fresh: "qAFresh xs z X' ∧ qAFresh xs z X''" and
alpha': "(X' #[[z ∧ x']]_xs) #= (X'' #[[z ∧ x'']]_xs)"
using * unfolding A' qAbs_alphaAbs_iff by auto
have goodX': "qGood X'"
using alpha ‹qGood X› alpha_qSwap_preserves_qGood by fastforce
hence goodX'': "qGood X''"
using alpha' alpha_qSwap_preserves_qGood by fastforce
have good: "qGood((X #[[y ∧ x]]_xs)) ∧ qGood((X' #[[z ∧ x']]_xs))"
using ‹qGood X› goodX' qSwap_preserves_qGood by auto
obtain u where u_not: "u ∉ {x,x',x'',y,z}" and
u_fresh: "qAFresh xs u X ∧ qAFresh xs u X' ∧ qAFresh xs u X''"
using ‹qGood X› goodX' goodX''
using obtain_qFresh[of "{x,x',x'',y,z}" "{X, X', X''}"] by auto
{have "(X #[[u ∧ x]]_xs) = ((X #[[y ∧ x]]_xs) #[[u ∧ y]]_xs)"
using u_fresh y_fresh by (auto simp add: qAFresh_qSwap_compose)
moreover
have "((X #[[y ∧ x]]_xs) #[[u ∧ y]]_xs) #= ((X' #[[y ∧ x']]_xs) #[[u ∧ y]]_xs)"
using good alpha qSwap_preserves_alpha by fastforce
moreover have "((X' #[[y ∧ x']]_xs) #[[u ∧ y]]_xs) = (X' #[[u ∧ x']]_xs)"
using u_fresh y_fresh by (auto simp add: qAFresh_qSwap_compose)
ultimately have "(X #[[u ∧ x]]_xs) #= (X' #[[u ∧ x']]_xs)" by simp
}
moreover
{have "(X' #[[u ∧ x']]_xs) = ((X' #[[z ∧ x']]_xs) #[[u ∧ z]]_xs)"
using u_fresh z_fresh by (auto simp add: qAFresh_qSwap_compose)
moreover
have "((X' #[[z ∧ x']]_xs) #[[u ∧ z]]_xs) #= ((X'' #[[z ∧ x'']]_xs) #[[u ∧ z]]_xs)"
using good alpha' qSwap_preserves_alpha by fastforce
moreover have "((X'' #[[z ∧ x'']]_xs) #[[u ∧ z]]_xs) = (X'' #[[u ∧ x'']]_xs)"
using u_fresh z_fresh by (auto simp add: qAFresh_qSwap_compose)
ultimately have "(X' #[[u ∧ x']]_xs) #= (X'' #[[u ∧ x'']]_xs)" by simp
}
moreover have "(X, X #[[u ∧ x]]_xs) ∈ qSwapped" by (simp add: qSwap_qSwapped)
ultimately have "(X #[[u ∧ x]]_xs) #= (X'' #[[u ∧ x'']]_xs)"
using Abs.IH by blast
thus "qAbs xs x X $= A''"
unfolding A'' using u_not u_fresh by auto
qed
qed
corollary alpha_trans:
assumes "qGood X ∨ qGood X' ∨ qGood X''" "X #= X'" "X' #= X''"
shows "X #= X''"
by (meson alphaAll_trans alpha_preserves_qGood assms)
corollary alphaAbs_trans:
assumes "qGoodAbs A ∨ qGoodAbs A' ∨ qGoodAbs A''"
and "A $= A'" "A' $= A''"
shows "A $= A''"
using assms alphaAbs_preserves_qGoodAbs alphaAll_trans by blast
lemma alpha_trans_twice:
"⟦qGood X ∨ qGood X' ∨ qGood X'' ∨ qGood X''';
X #= X'; X' #= X''; X'' #= X'''⟧ ⟹ X #= X'''"
using alpha_trans by blast
lemma alphaAbs_trans_twice:
"⟦qGoodAbs A ∨ qGoodAbs A' ∨ qGoodAbs A'' ∨ qGoodAbs A''';
A $= A'; A' $= A''; A'' $= A'''⟧ ⟹ A $= A'''"
using alphaAbs_trans by blast
lemma qAbs_preserves_alpha:
assumes ALPHA: "X #= X'" and GOOD: "qGood X ∨ qGood X'"
shows "qAbs xs x X $= qAbs xs x X'"
proof-
have "qGood X ∧ qGood X'" using GOOD ALPHA by(auto simp add: alpha_preserves_qGood)
then obtain y where y_not: "y ≠ x" and
y_fresh: "qAFresh xs y X ∧ qAFresh xs y X'"
using GOOD obtain_qFresh[of "{x}" "{X,X'}"] by auto
hence "(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x]]_xs)"
using ALPHA GOOD by(simp add: qSwap_preserves_alpha)
thus ?thesis using y_not y_fresh by auto
qed
corollary qAbs_preserves_alpha2:
assumes ALPHA: "X #= X'" and GOOD: "qGoodAbs(qAbs xs x X) ∨ qGoodAbs (qAbs xs x X')"
shows "qAbs xs x X $= qAbs xs x X'"
using assms by (intro qAbs_preserves_alpha) auto
subsubsection ‹Picking fresh representatives›
lemma qAbs_alphaAbs_qSwap_qAFresh:
assumes GOOD: "qGood X" and FRESH: "qAFresh ys x' X"
shows "qAbs ys x X $= qAbs ys x' (X #[[x' ∧ x]]_ys)"
proof-
obtain y where 1: "y ∉ {x,x'}" and 2: "qAFresh ys y X"
using GOOD obtain_qFresh[of "{x,x'}" "{X}"] by auto
hence 3: "qAFresh ys y (X #[[x' ∧ x]]_ys)"
by (auto simp add: qSwap_preserves_qAFresh_distinct)
have "(X #[[y ∧ x]]_ys) = ((X #[[x' ∧ x]]_ys) #[[y ∧ x']]_ys)"
using FRESH 2 by (auto simp add: qAFresh_qSwap_compose)
moreover have "qGood (X #[[y ∧ x]]_ys)"
using 1 GOOD qSwap_preserves_qGood by auto
ultimately have "(X #[[y ∧ x]]_ys) #= ((X #[[x' ∧ x]]_ys) #[[y ∧ x']]_ys)"
using alpha_refl by simp
thus ?thesis using 1 2 3 assms by auto
qed
lemma qAbs_ex_qAFresh_rep:
assumes GOOD: "qGood X" and FRESH: "qAFresh xs x' X"
shows "∃ X'. qGood X' ∧ qAbs xs x X $= qAbs xs x' X'"
proof-
have 1: "qGood (X #[[x' ∧ x]]_xs)" using assms qSwap_preserves_qGood by auto
show ?thesis
apply(rule exI[of _ "X #[[x' ∧ x]]_xs"])
using assms 1 qAbs_alphaAbs_qSwap_qAFresh by fastforce
qed
subsection ‹Properties of swapping and freshness modulo alpha›
lemma qFreshAll_imp_ex_qAFreshAll:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and zs fZs
assumes FIN: "finite V"
shows
"(qGood X ⟶
((∀ z ∈ V. ∀ zs ∈ fZs z. qFresh zs z X) ⟶
(∃ X'. X #= X' ∧ (∀ z ∈ V. ∀ zs ∈ fZs z. qAFresh zs z X')))) ∧
(qGoodAbs A ⟶
((∀ z ∈ V. ∀ zs ∈ fZs z. qFreshAbs zs z A) ⟶
(∃ A'. A $= A' ∧ (∀ z ∈ V. ∀ zs ∈ fZs z. qAFreshAbs zs z A'))))"
proof(induction rule: qGood_qTerm_induct)
case (Var xs x)
show ?case
by (metis alpha_qVar_iff qAFreshAll_simps(1) qFreshAll_simps(1))
next
case (Op delta inp binp)
show ?case proof safe
assume *: "∀z∈V. ∀zs∈fZs z. qFresh zs z (qOp delta inp binp)"
define phi and phiAbs where
"phi ≡ (λ(Y::('index,'bindex,'varSort,'var,'opSym)qTerm) Y'.
Y #= Y' ∧ (∀z∈V. ∀zs∈fZs z. qAFresh zs z Y'))" and
"phiAbs ≡ (λ(A::('index,'bindex,'varSort,'var,'opSym)qAbs) A'.
A $= A' ∧ (∀z∈V. ∀zs∈fZs z. qAFreshAbs zs z A'))"
have ex_phi: "⋀ i Y. inp i = Some Y ⟹ ∃Y'. phi Y Y'"
unfolding phi_def using Op.IH * by (auto simp add: liftAll_def)
have ex_phiAbs: "⋀ i A. binp i = Some A ⟹ ∃A'. phiAbs A A'"
unfolding phiAbs_def using Op.IH * by (auto simp add: liftAll_def)
define inp' and binp' where
"inp' ≡ λ i. case inp i of Some Y ⇒ Some (SOME Y'. phi Y Y') |None ⇒ None" and
"binp' ≡ λ i. case binp i of Some A ⇒ Some (SOME A'. phiAbs A A') |None ⇒ None"
show "∃X'. qOp delta inp binp #= X' ∧ (∀z∈V. ∀zs∈fZs z. qAFresh zs z X')"
by (intro exI[of _ "qOp delta inp' binp'"])
(auto simp add: inp'_def binp'_def option.case_eq_if sameDom_def liftAll_def liftAll2_def,
(meson ex_phi phi_def ex_phiAbs phiAbs_def some_eq_ex)+)
qed
next
case (Abs xs x X)
show ?case proof safe
assume *: "∀z∈V. ∀zs∈fZs z. qFreshAbs zs z (qAbs xs x X)"
obtain y where y_not_x: "y ≠ x" and y_not_V: "y ∉ V"
and y_afresh: "qAFresh xs y X"
using FIN ‹qGood X› obtain_qFresh[of "V ∪ {x}" "{X}"] by auto
hence y_fresh: "qFresh xs y X" using qAFresh_imp_qFresh by fastforce
obtain Y where Y_def: "Y = (X #[[y ∧ x ]]_xs)" by blast
have alphaXY: "qAbs xs x X $= qAbs xs y Y"
using ‹qGood X› y_afresh qAbs_alphaAbs_qSwap_qAFresh unfolding Y_def by fastforce
have "∀z∈V. ∀zs ∈ fZs z. qFresh zs z Y"
unfolding Y_def
by (metis * not_equals_and_not_equals_not_in qAFresh_imp_qFresh qAFresh_qSwap_exchange1
qFreshAbs.simps qSwap_preserves_qFresh_distinct y_afresh y_not_V)
moreover have "(X,Y) ∈ qSwapped" unfolding Y_def by(simp add: qSwap_qSwapped)
ultimately obtain Y' where "Y #= Y'" and **: "∀z∈V. ∀zs ∈ fZs z. qAFresh zs z Y'"
using Abs.IH by blast
moreover have "qGood Y" unfolding Y_def using ‹qGood X› qSwap_preserves_qGood by auto
ultimately have "qAbs xs y Y $= qAbs xs y Y'" using qAbs_preserves_alpha by blast
moreover have "qGoodAbs(qAbs xs x X)" using ‹qGood X› by simp
ultimately have "qAbs xs x X $= qAbs xs y Y'" using alphaXY alphaAbs_trans by blast
moreover have "∀z∈V. ∀zs ∈ fZs z. qAFreshAbs zs z (qAbs xs y Y')" using ** y_not_V by auto
ultimately show "∃A'. qAbs xs x X $= A' ∧ (∀z∈V. ∀zs ∈ fZs z. qAFreshAbs zs z A')"
by blast
qed
qed
corollary qFresh_imp_ex_qAFresh:
assumes "finite V" and "qGood X" and "∀ z ∈ V. ∀zs ∈ fZs z. qFresh zs z X"
shows "∃ X'. qGood X' ∧ X #= X' ∧ (∀ z ∈ V. ∀zs ∈ fZs z. qAFresh zs z X')"
by (metis alphaAll_preserves_qGoodAll1 assms qFreshAll_imp_ex_qAFreshAll)
corollary qFreshAbs_imp_ex_qAFreshAbs:
assumes "finite V" and "qGoodAbs A" and "∀ z ∈ V. ∀zs ∈ fZs z. qFreshAbs zs z A"
shows "∃ A'. qGoodAbs A' ∧ A $= A' ∧ (∀ z ∈ V. ∀zs ∈ fZs z. qAFreshAbs zs z A')"
by (metis alphaAll_preserves_qGoodAll1 assms qFreshAll_imp_ex_qAFreshAll)
lemma qFresh_imp_ex_qAFresh1:
assumes "qGood X" and "qFresh zs z X"
shows "∃ X'. qGood X' ∧ X #= X' ∧ qAFresh zs z X'"
using assms qFresh_imp_ex_qAFresh[of "{z}" _ "undefined(z := {zs})"] by fastforce
lemma qFreshAbs_imp_ex_qAFreshAbs1:
assumes "finite V" and "qGoodAbs A" and "qFreshAbs zs z A"
shows "∃ A'. qGoodAbs A' ∧ A $= A' ∧ qAFreshAbs zs z A'"
using assms qFreshAbs_imp_ex_qAFreshAbs[of "{z}" _ "undefined(z := {zs})"] by fastforce
lemma qFresh_imp_ex_qAFresh2:
assumes "qGood X" and "qFresh xs x X" and "qFresh ys y X"
shows "∃ X'. qGood X' ∧ X #= X' ∧ qAFresh xs x X' ∧ qAFresh ys y X'"
using assms
qFresh_imp_ex_qAFresh[of "{x}" _ "undefined(x := {xs,ys})"]
qFresh_imp_ex_qAFresh[of "{x,y}" _ "(undefined(x := {xs}))(y := {ys})"]
by (cases "x = y") auto
lemma qFreshAbs_imp_ex_qAFreshAbs2:
assumes "finite V" and "qGoodAbs A" and "qFreshAbs xs x A" and "qFreshAbs ys y A"
shows "∃ A'. qGoodAbs A' ∧ A $= A' ∧ qAFreshAbs xs x A' ∧ qAFreshAbs ys y A'"
using assms
qFreshAbs_imp_ex_qAFreshAbs[of "{x}" _ "undefined(x := {xs,ys})"]
qFreshAbs_imp_ex_qAFreshAbs[of "{x,y}" _ "(undefined(x := {xs}))(y := {ys})"]
by (cases "x = y") auto
lemma qAFreshAll_qFreshAll_preserves_alphaAll:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and zs z
shows
"(qGood X ⟶
(qAFresh zs z X ⟶ (∀ X'. X #= X' ⟶ qFresh zs z X'))) ∧
(qGoodAbs A ⟶
(qAFreshAbs zs z A ⟶ (∀ A'. A $= A' ⟶ qFreshAbs zs z A')))"
proof(induction rule: qGood_qTerm_induct)
case (Var xs x)
thus ?case unfolding qVar_alpha_iff by simp
next
case (Op delta inp binp)
show ?case proof safe
fix X'
assume afresh: "qAFresh zs z (qOp delta inp binp)"
and "qOp delta inp binp #= X'"
then obtain inp' and binp' where X'eq: "X' = qOp delta inp' binp'" and
*: "(∀i. (inp i = None) = (inp' i = None)) ∧
(∀i. (binp i = None) = (binp' i = None))" and
**: "(∀i Y Y'. inp i = Some Y ∧ inp' i = Some Y' ⟶ Y #= Y') ∧
(∀i A A'. binp i = Some A ∧ binp' i = Some A' ⟶ A $= A')"
unfolding qOp_alpha_iff sameDom_def liftAll2_def by auto
{fix i Y' assume inp': "inp' i = Some Y'"
then obtain Y where inp: "inp i = Some Y" using * by fastforce
hence "Y #= Y'" using inp' ** by blast
hence "qFresh zs z Y'" using inp Op.IH afresh by (auto simp: liftAll_def)
}
moreover
{fix i A' assume binp': "binp' i = Some A'"
then obtain A where binp: "binp i = Some A" using * by fastforce
hence "A $= A'" using binp' ** by blast
hence "qFreshAbs zs z A'" using binp Op.IH afresh by (auto simp: liftAll_def)
}
ultimately show "qFresh zs z X'"
unfolding X'eq apply simp unfolding liftAll_def by simp
qed
next
case (Abs xs x X)
show ?case proof safe
fix A'
assume "qAbs xs x X $= A'" and afresh: "qAFreshAbs zs z (qAbs xs x X)"
then obtain x' y X' where A'eq: "A' = qAbs xs x' X'" and
ynot: "y ∉ {x, x'}" and y_afresh: "qAFresh xs y X ∧ qAFresh xs y X'" and
alpha: "(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)"
unfolding qAbs_alphaAbs_iff by auto
have goodXxy: "qGood(X #[[y ∧ x]]_xs)" using ‹qGood X› qSwap_preserves_qGood by auto
hence goodX'yx': "qGood(X' #[[y ∧ x']]_xs)" using alpha alpha_preserves_qGood by auto
hence "qGood X'" using qSwap_preserves_qGood by auto
then obtain u where u_afresh: "qAFresh xs u X ∧ qAFresh xs u X'"
and unot: "u ∉ {x,x',z}" using ‹qGood X› obtain_qFresh[of "{x,x',z}" "{X,X'}"] by auto
have "(X #[[u ∧ x]]_xs) = ((X #[[y ∧ x]]_xs) #[[u ∧ y]]_xs) ∧
(X' #[[u ∧ x']]_xs) = ((X' #[[y ∧ x']]_xs) #[[u ∧ y]]_xs)"
using u_afresh y_afresh qAFresh_qSwap_compose by fastforce
moreover have "((X #[[y ∧ x]]_xs) #[[u ∧ y]]_xs) #= ((X' #[[y ∧ x']]_xs) #[[u ∧ y]]_xs)"
using goodXxy goodX'yx' alpha qSwap_preserves_alpha by fastforce
ultimately have alpha: "(X #[[u ∧ x]]_xs) #= (X' #[[u ∧ x']]_xs)" by simp
moreover have "(X, X #[[u ∧ x]]_xs) ∈ qSwapped" by (simp add: qSwap_qSwapped)
moreover have "qAFresh zs z (X #[[u ∧ x]]_xs)"
using unot afresh by(auto simp add: qSwap_preserves_qAFresh_distinct)
ultimately have "qFresh zs z (X' #[[u ∧ x']]_xs)" using afresh Abs.IH by simp
hence "zs = xs ∧ z = x' ∨ qFresh zs z X'"
using unot afresh qSwap_preserves_qFresh_distinct[of zs xs z] by fastforce
thus "qFreshAbs zs z A'" unfolding A'eq by simp
qed
qed
corollary qAFresh_qFresh_preserves_alpha:
"⟦qGood X; qAFresh zs z X; X #= X'⟧ ⟹ qFresh zs z X'"
by(simp add: qAFreshAll_qFreshAll_preserves_alphaAll)
corollary qAFreshAbs_imp_qFreshAbs_preserves_alphaAbs:
"⟦qGoodAbs A; qAFreshAbs zs z A; A $= A'⟧ ⟹ qFreshAbs zs z A'"
by(simp add: qAFreshAll_qFreshAll_preserves_alphaAll)
lemma qFresh_preserves_alpha1:
assumes "qGood X" and "qFresh zs z X" and "X #= X'"
shows "qFresh zs z X'"
by (meson alpha_sym alpha_trans assms qAFresh_qFresh_preserves_alpha qFresh_imp_ex_qAFresh1)
lemma qFreshAbs_preserves_alphaAbs1:
assumes "qGoodAbs A" and "qFreshAbs zs z A" and "A $= A'"
shows "qFreshAbs zs z A'"
by (meson alphaAbs_sym alphaAbs_trans assms finite.emptyI
qAFreshAbs_imp_qFreshAbs_preserves_alphaAbs qFreshAbs_imp_ex_qAFreshAbs1)
lemma qFresh_preserves_alpha:
assumes "qGood X ∨ qGood X'" and "X #= X'"
shows "qFresh zs z X ⟷ qFresh zs z X'"
using alpha_preserves_qGood alpha_sym assms qFresh_preserves_alpha1 by blast
lemma qFreshAbs_preserves_alphaAbs:
assumes "qGoodAbs A ∨ qGoodAbs A'" and "A $= A'"
shows "qFreshAbs zs z A = qFreshAbs zs z A'"
using assms alphaAbs_preserves_qGoodAbs alphaAbs_sym qFreshAbs_preserves_alphaAbs1 by blast
lemma alpha_qFresh_qSwap_id:
assumes "qGood X" and "qFresh zs z1 X" and "qFresh zs z2 X"
shows "(X #[[z1 ∧ z2]]_zs) #= X"
proof-
obtain X' where 1: "X #= X'" and "qAFresh zs z1 X' ∧ qAFresh zs z2 X'"
using assms qFresh_imp_ex_qAFresh2 by force
hence "(X' #[[z1 ∧ z2]]_zs) = X'" using qAFresh_qSwap_id by auto
moreover have "(X #[[z1 ∧ z2]]_zs) #= (X' #[[z1 ∧ z2]]_zs)"
using assms 1 by (auto simp add: qSwap_preserves_alpha)
moreover have "X' #= X" using 1 alpha_sym by auto
moreover have "qGood(X #[[z1 ∧ z2]]_zs)" using assms qSwap_preserves_qGood by auto
ultimately show ?thesis using alpha_trans by auto
qed
lemma alphaAbs_qFreshAbs_qSwapAbs_id:
assumes "qGoodAbs A" and "qFreshAbs zs z1 A" and "qFreshAbs zs z2 A"
shows "(A $[[z1 ∧ z2]]_zs) $= A"
proof-
obtain A' where 1: "A $= A'" and "qAFreshAbs zs z1 A' ∧ qAFreshAbs zs z2 A'"
using assms qFreshAbs_imp_ex_qAFreshAbs2 by force
hence "(A' $[[z1 ∧ z2]]_zs) = A'" using qAFreshAll_qSwapAll_id by fastforce
moreover have "(A $[[z1 ∧ z2]]_zs) $= (A' $[[z1 ∧ z2]]_zs)"
using assms 1 by (auto simp add: qSwapAbs_preserves_alphaAbs)
moreover have "A' $= A" using 1 alphaAbs_sym by auto
moreover have "qGoodAbs (A $[[z1 ∧ z2]]_zs)" using assms qSwapAbs_preserves_qGoodAbs by auto
ultimately show ?thesis using alphaAbs_trans by auto
qed
lemma alpha_qFresh_qSwap_compose:
assumes GOOD: "qGood X" and "qFresh zs y X" and "qFresh zs z X"
shows "((X #[[y ∧ x]]_zs) #[[z ∧ y]]_zs) #= (X #[[z ∧ x]]_zs)"
proof-
obtain X' where 1: "X #= X'" and "qAFresh zs y X' ∧ qAFresh zs z X'"
using assms qFresh_imp_ex_qAFresh2 by force
hence "((X' #[[y ∧ x]]_zs) #[[z ∧ y]]_zs) = (X' #[[z ∧ x]]_zs)"
using qAFresh_qSwap_compose by auto
moreover have "((X #[[y ∧ x]]_zs) #[[z ∧ y]]_zs) #= ((X' #[[y ∧ x]]_zs) #[[z ∧ y]]_zs)"
using GOOD 1 by (auto simp add: qSwap_twice_preserves_alpha)
moreover have "(X' #[[z ∧ x]]_zs) #= (X #[[z ∧ x]]_zs)"
using GOOD 1 by (auto simp add: qSwap_preserves_alpha alpha_sym)
moreover have "qGood ((X #[[y ∧ x]]_zs) #[[z ∧ y]]_zs)"
using GOOD by (auto simp add: qSwap_twice_preserves_qGood)
ultimately show ?thesis using alpha_trans by auto
qed
lemma qAbs_alphaAbs_qSwap_qFresh:
assumes GOOD: "qGood X" and FRESH: "qFresh xs x' X"
shows "qAbs xs x X $= qAbs xs x' (X #[[x' ∧ x]]_xs)"
proof-
obtain Y where good_Y: "qGood Y" and alpha: "X #= Y" and fresh_Y: "qAFresh xs x' Y"
using assms qFresh_imp_ex_qAFresh1 by fastforce
hence "qAbs xs x Y $= qAbs xs x' (Y #[[x' ∧ x]]_xs)"
using qAbs_alphaAbs_qSwap_qAFresh by blast
moreover have "qAbs xs x X $= qAbs xs x Y"
using GOOD alpha qAbs_preserves_alpha by fastforce
moreover
{have "Y #[[x' ∧ x]]_xs #= X #[[x' ∧ x]]_xs"
using GOOD alpha by (auto simp add: qSwap_preserves_alpha alpha_sym)
moreover have "qGood (Y #[[x' ∧ x]]_xs)" using good_Y qSwap_preserves_qGood by auto
ultimately have "qAbs xs x' (Y #[[x' ∧ x]]_xs) $= qAbs xs x' (X #[[x' ∧ x]]_xs)"
using qAbs_preserves_alpha by blast
}
moreover have "qGoodAbs (qAbs xs x X)" using GOOD by simp
ultimately show ?thesis using alphaAbs_trans by blast
qed
lemma alphaAbs_qAbs_ex_qFresh_rep:
assumes GOOD: "qGood X" and FRESH: "qFresh xs x' X"
shows "∃ X'. (X,X') ∈ qSwapped ∧ qGood X' ∧ qAbs xs x X $= qAbs xs x' X'"
proof-
have 1: "qGood (X #[[x' ∧ x]]_xs)" using assms qSwap_preserves_qGood by auto
have 2: "(X,X #[[x' ∧ x]]_xs) ∈ qSwapped" by(simp add: qSwap_qSwapped)
show ?thesis
apply(rule exI[of _ "X #[[x' ∧ x]]_xs"])
using assms 1 2 qAbs_alphaAbs_qSwap_qFresh by fastforce
qed
subsection ‹Alternative statements of the alpha-clause for bound arguments›
text‹These alternatives are essentially variations with forall/exists and and qFresh/qAFresh.›
subsubsection ‹First for ``qAFresh"›
definition alphaAbs_ex_equal_or_qAFresh
where
"alphaAbs_ex_equal_or_qAFresh xs x X xs' x' X' ==
(xs = xs' ∧
(∃ y. (y = x ∨ qAFresh xs y X) ∧ (y = x' ∨ qAFresh xs y X') ∧
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
definition alphaAbs_ex_qAFresh
where
"alphaAbs_ex_qAFresh xs x X xs' x' X' ==
(xs = xs' ∧
(∃ y. qAFresh xs y X ∧ qAFresh xs y X' ∧
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
definition alphaAbs_ex_distinct_qAFresh
where
"alphaAbs_ex_distinct_qAFresh xs x X xs' x' X' ==
(xs = xs' ∧
(∃ y. y ∉ {x,x'} ∧ qAFresh xs y X ∧ qAFresh xs y X' ∧
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
definition alphaAbs_all_equal_or_qAFresh
where
"alphaAbs_all_equal_or_qAFresh xs x X xs' x' X' ==
(xs = xs' ∧
(∀ y. (y = x ∨ qAFresh xs y X) ∧ (y = x' ∨ qAFresh xs y X') ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
definition alphaAbs_all_qAFresh
where
"alphaAbs_all_qAFresh xs x X xs' x' X' ==
(xs = xs' ∧
(∀ y. qAFresh xs y X ∧ qAFresh xs y X' ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
definition alphaAbs_all_distinct_qAFresh
where
"alphaAbs_all_distinct_qAFresh xs x X xs' x' X' ==
(xs = xs' ∧
(∀ y. y ∉ {x,x'} ∧ qAFresh xs y X ∧ qAFresh xs y X' ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
lemma alphaAbs_weakestEx_imp_strongestAll:
assumes GOOD_X: "qGood X" and "alphaAbs_ex_equal_or_qAFresh xs x X xs' x' X'"
shows "alphaAbs_all_equal_or_qAFresh xs x X xs' x' X'"
proof-
obtain y where xs: "xs = xs'" and
yEqFresh: "(y = x ∨ qAFresh xs y X) ∧ (y = x' ∨ qAFresh xs y X')" and
alpha: "(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)"
using assms by (auto simp add: alphaAbs_ex_equal_or_qAFresh_def)
show ?thesis
using xs unfolding alphaAbs_all_equal_or_qAFresh_def
proof(intro conjI allI impI, simp)
fix z assume zFresh: "(z = x ∨ qAFresh xs z X) ∧ (z = x' ∨ qAFresh xs z X')"
have "(X #[[z ∧ x]]_xs) = ((X #[[y ∧ x]]_xs) #[[z ∧ y]]_xs)"
proof(cases "z = x")
assume Case1: "z = x"
thus ?thesis by(auto simp add: qSwap_sym)
next
assume Case2: "z ≠ x"
hence z_fresh: "qAFresh xs z X" using zFresh by auto
show ?thesis
proof(cases "y = x")
assume Case21: "y = x"
show ?thesis unfolding Case21 by simp
next
assume Case22: "y ≠ x"
hence "qAFresh xs y X" using yEqFresh by auto
thus ?thesis using z_fresh qAFresh_qSwap_compose by fastforce
qed
qed
moreover
have "(X' #[[z ∧ x']]_xs) = ((X' #[[y ∧ x']]_xs) #[[z ∧ y]]_xs)"
proof(cases "z = x'")
assume Case1: "z = x'"
thus ?thesis by(auto simp add: qSwap_sym)
next
assume Case2: "z ≠ x'"
hence z_fresh: "qAFresh xs z X'" using zFresh by auto
show ?thesis
proof(cases "y = x'")
assume Case21: "y = x'"
show ?thesis unfolding Case21 by simp
next
assume Case22: "y ≠ x'"
hence "qAFresh xs y X'" using yEqFresh by auto
thus ?thesis using z_fresh qAFresh_qSwap_compose by fastforce
qed
qed
moreover
{have "qGood (X #[[y ∧ x]]_xs)" using GOOD_X qSwap_preserves_qGood by auto
hence "((X #[[y ∧ x]]_xs) #[[z ∧ y]]_xs) #= ((X' #[[y ∧ x']]_xs) #[[z ∧ y]]_xs)"
using alpha qSwap_preserves_alpha by fastforce
}
ultimately show "(X #[[z ∧ x]]_xs) #= (X' #[[z ∧ x']]_xs)" by simp
qed
qed
lemma alphaAbs_weakestAll_imp_strongestEx:
assumes GOOD: "qGood X" "qGood X'"
and "alphaAbs_all_distinct_qAFresh xs x X xs' x' X'"
shows "alphaAbs_ex_distinct_qAFresh xs x X xs' x' X'"
proof-
have xs: "xs = xs'"
using assms unfolding alphaAbs_all_distinct_qAFresh_def by auto
obtain y where y_not: "y ∉ {x,x'}" and
yFresh: "qAFresh xs y X ∧ qAFresh xs y X'"
using GOOD obtain_qFresh[of "{x,x'}" "{X,X'}"] by auto
hence "(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)"
using assms unfolding alphaAbs_all_distinct_qAFresh_def by auto
thus ?thesis unfolding alphaAbs_ex_distinct_qAFresh_def using xs y_not yFresh by auto
qed
lemma alphaAbs_weakestEx_imp_strongestEx:
assumes GOOD: "qGood X"
and "alphaAbs_ex_equal_or_qAFresh xs x X xs' x' X'"
shows "alphaAbs_ex_distinct_qAFresh xs x X xs' x' X'"
proof-
obtain y where xs: "xs = xs'" and
yEqFresh: "(y = x ∨ qAFresh xs y X) ∧ (y = x' ∨ qAFresh xs y X')" and
alpha: "(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)"
using assms unfolding alphaAbs_ex_equal_or_qAFresh_def by blast
hence goodX': "qGood X'"
using GOOD alpha_qSwap_preserves_qGood by fastforce
then obtain z where zNot: "z ∉ {x,x',y}" and
zFresh: "qAFresh xs z X ∧ qAFresh xs z X'"
using GOOD obtain_qFresh[of "{x,x',y}" "{X,X'}"] by auto
have "(X #[[z ∧ x]]_xs) = ((X #[[y ∧ x]]_xs) #[[z ∧ y]]_xs)"
proof(cases "y = x", simp)
assume "y ≠ x" hence "qAFresh xs y X" using yEqFresh by auto
thus ?thesis using zFresh qAFresh_qSwap_compose by fastforce
qed
moreover have "(X' #[[z ∧ x']]_xs) = ((X' #[[y ∧ x']]_xs) #[[z ∧ y]]_xs)"
proof(cases "y = x'", simp add: qSwap_ident)
assume "y ≠ x'" hence "qAFresh xs y X'" using yEqFresh by auto
thus ?thesis using zFresh qAFresh_qSwap_compose by fastforce
qed
moreover
{have "qGood (X #[[y ∧ x]]_xs)" using GOOD qSwap_preserves_qGood by auto
hence "((X #[[y ∧ x]]_xs) #[[z ∧ y]]_xs) #= ((X' #[[y ∧ x']]_xs) #[[z ∧ y]]_xs)"
using alpha by (auto simp add: qSwap_preserves_alpha)
}
ultimately have "(X #[[z ∧ x]]_xs) #= (X' #[[z ∧ x']]_xs)" by simp
thus ?thesis unfolding alphaAbs_ex_distinct_qAFresh_def using xs zNot zFresh by auto
qed
lemma alphaAbs_qAbs_iff_alphaAbs_ex_distinct_qAFresh:
"(qAbs xs x X $= qAbs xs' x' X') = alphaAbs_ex_distinct_qAFresh xs x X xs' x' X'"
unfolding alphaAbs_ex_distinct_qAFresh_def by auto
corollary alphaAbs_qAbs_iff_ex_distinct_qAFresh:
"(qAbs xs x X $= qAbs xs' x' X') =
(xs = xs' ∧
(∃ y. y ∉ {x,x'} ∧ qAFresh xs y X ∧ qAFresh xs y X' ∧
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
unfolding alphaAbs_qAbs_iff_alphaAbs_ex_distinct_qAFresh
alphaAbs_ex_distinct_qAFresh_def by fastforce
lemma alphaAbs_qAbs_iff_alphaAbs_ex_equal_or_qAFresh:
assumes "qGood X"
shows "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_ex_equal_or_qAFresh xs x X xs' x' X'"
proof-
let ?Left = "qAbs xs x X $= qAbs xs' x' X'"
let ?Right = "alphaAbs_ex_equal_or_qAFresh xs x X xs' x' X'"
have "?Left ⟹ ?Right" unfolding alphaAbs_ex_equal_or_qAFresh_def by auto
moreover have "?Right ⟹ ?Left"
using assms alphaAbs_qAbs_iff_alphaAbs_ex_distinct_qAFresh[of _ _ X]
alphaAbs_weakestEx_imp_strongestEx by auto
ultimately show ?thesis by auto
qed
corollary alphaAbs_qAbs_iff_ex_equal_or_qAFresh:
assumes "qGood X"
shows
"(qAbs xs x X $= qAbs xs' x' X') =
(xs = xs' ∧
(∃ y. (y = x ∨ qAFresh xs y X) ∧ (y = x' ∨ qAFresh xs y X') ∧
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
proof-
have "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_ex_equal_or_qAFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_iff_alphaAbs_ex_equal_or_qAFresh by fastforce
thus ?thesis unfolding alphaAbs_ex_equal_or_qAFresh_def .
qed
lemma alphaAbs_qAbs_iff_alphaAbs_ex_qAFresh:
assumes "qGood X"
shows "(qAbs xs x X $= qAbs xs' x' X') = alphaAbs_ex_qAFresh xs x X xs' x' X'"
proof-
let ?Left = "qAbs xs x X $= qAbs xs' x' X'"
let ?Middle = "alphaAbs_ex_equal_or_qAFresh xs x X xs' x' X'"
let ?Right = "alphaAbs_ex_qAFresh xs x X xs' x' X'"
have "?Left ⟹ ?Right" unfolding alphaAbs_ex_qAFresh_def by auto
moreover have "?Right ⟹ ?Middle"
unfolding alphaAbs_ex_qAFresh_def alphaAbs_ex_equal_or_qAFresh_def by auto
moreover have "?Middle = ?Left"
using assms alphaAbs_qAbs_iff_alphaAbs_ex_equal_or_qAFresh[of X] by fastforce
ultimately show ?thesis by blast
qed
corollary alphaAbs_qAbs_iff_ex_qAFresh:
assumes "qGood X"
shows
"(qAbs xs x X $= qAbs xs' x' X') =
(xs = xs' ∧
(∃ y. qAFresh xs y X ∧ qAFresh xs y X' ∧
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
proof-
have "(qAbs xs x X $= qAbs xs' x' X') = alphaAbs_ex_qAFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_iff_alphaAbs_ex_qAFresh by fastforce
thus ?thesis unfolding alphaAbs_ex_qAFresh_def .
qed
lemma alphaAbs_qAbs_imp_alphaAbs_all_equal_or_qAFresh:
assumes "qGood X" and "qAbs xs x X $= qAbs xs' x' X'"
shows "alphaAbs_all_equal_or_qAFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_iff_alphaAbs_ex_equal_or_qAFresh
alphaAbs_weakestEx_imp_strongestAll by fastforce
corollary alphaAbs_qAbs_imp_all_equal_or_qAFresh:
assumes "qGood X" and "(qAbs xs x X $= qAbs xs' x' X')"
shows
"(xs = xs' ∧
(∀ y. (y = x ∨ qAFresh xs y X) ∧ (y = x' ∨ qAFresh xs y X') ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
proof-
have "alphaAbs_all_equal_or_qAFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_imp_alphaAbs_all_equal_or_qAFresh by blast
thus ?thesis unfolding alphaAbs_all_equal_or_qAFresh_def .
qed
lemma alphaAbs_qAbs_iff_alphaAbs_all_equal_or_qAFresh:
assumes "qGood X" and "qGood X'"
shows "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_all_equal_or_qAFresh xs x X xs' x' X'"
proof-
let ?Left = "qAbs xs x X $= qAbs xs' x' X'"
let ?MiddleEx = "alphaAbs_ex_distinct_qAFresh xs x X xs' x' X'"
let ?MiddleAll = "alphaAbs_all_distinct_qAFresh xs x X xs' x' X'"
let ?Right = "alphaAbs_all_equal_or_qAFresh xs x X xs' x' X'"
have "?Left ⟹ ?Right"
using assms alphaAbs_qAbs_imp_alphaAbs_all_equal_or_qAFresh by blast
moreover have "?Right ⟹ ?MiddleAll"
unfolding alphaAbs_all_equal_or_qAFresh_def alphaAbs_all_distinct_qAFresh_def by auto
moreover have "?MiddleAll ⟹ ?MiddleEx"
using assms alphaAbs_weakestAll_imp_strongestEx by fastforce
moreover have "?MiddleEx ⟹ ?Left"
using alphaAbs_qAbs_iff_alphaAbs_ex_distinct_qAFresh[of _ _ X] by fastforce
ultimately show ?thesis by blast
qed
corollary alphaAbs_qAbs_iff_all_equal_or_qAFresh:
assumes "qGood X" and "qGood X'"
shows "(qAbs xs x X $= qAbs xs' x' X') =
(xs = xs' ∧
(∀ y. (y = x ∨ qAFresh xs y X) ∧ (y = x' ∨ qAFresh xs y X') ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
proof-
have "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_all_equal_or_qAFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_iff_alphaAbs_all_equal_or_qAFresh by blast
thus ?thesis unfolding alphaAbs_all_equal_or_qAFresh_def .
qed
lemma alphaAbs_qAbs_imp_alphaAbs_all_qAFresh:
assumes "qGood X" and "qAbs xs x X $= qAbs xs' x' X'"
shows "alphaAbs_all_qAFresh xs x X xs' x' X'"
proof-
have "alphaAbs_all_equal_or_qAFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_imp_alphaAbs_all_equal_or_qAFresh by blast
thus ?thesis unfolding alphaAbs_all_qAFresh_def alphaAbs_all_equal_or_qAFresh_def by auto
qed
corollary alphaAbs_qAbs_imp_all_qAFresh:
assumes "qGood X" and "(qAbs xs x X $= qAbs xs' x' X')"
shows
"(xs = xs' ∧
(∀ y. qAFresh xs y X ∧ qAFresh xs y X' ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
proof-
have "alphaAbs_all_qAFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_imp_alphaAbs_all_qAFresh by blast
thus ?thesis unfolding alphaAbs_all_qAFresh_def .
qed
lemma alphaAbs_qAbs_iff_alphaAbs_all_qAFresh:
assumes "qGood X" and "qGood X'"
shows "(qAbs xs x X $= qAbs xs' x' X') = alphaAbs_all_qAFresh xs x X xs' x' X'"
proof-
let ?Left = "qAbs xs x X $= qAbs xs' x' X'"
let ?MiddleEx = "alphaAbs_ex_distinct_qAFresh xs x X xs' x' X'"
let ?MiddleAll = "alphaAbs_all_distinct_qAFresh xs x X xs' x' X'"
let ?Right = "alphaAbs_all_qAFresh xs x X xs' x' X'"
have "?Left ⟹ ?Right" using assms alphaAbs_qAbs_imp_alphaAbs_all_qAFresh by blast
moreover have "?Right ⟹ ?MiddleAll"
unfolding alphaAbs_all_qAFresh_def alphaAbs_all_distinct_qAFresh_def by auto
moreover have "?MiddleAll ⟹ ?MiddleEx"
using assms alphaAbs_weakestAll_imp_strongestEx by fastforce
moreover have "?MiddleEx ⟹ ?Left"
using assms alphaAbs_qAbs_iff_alphaAbs_ex_distinct_qAFresh[of _ _ X] by fastforce
ultimately show ?thesis by blast
qed
corollary alphaAbs_qAbs_iff_all_qAFresh:
assumes "qGood X" and "qGood X'"
shows "(qAbs xs x X $= qAbs xs' x' X') =
(xs = xs' ∧
(∀ y. qAFresh xs y X ∧ qAFresh xs y X' ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
proof-
have "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_all_qAFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_iff_alphaAbs_all_qAFresh by blast
thus ?thesis unfolding alphaAbs_all_qAFresh_def .
qed
lemma alphaAbs_qAbs_imp_alphaAbs_all_distinct_qAFresh:
assumes "qGood X" and "qAbs xs x X $= qAbs xs' x' X'"
shows "alphaAbs_all_distinct_qAFresh xs x X xs' x' X'"
proof-
have "alphaAbs_all_equal_or_qAFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_imp_alphaAbs_all_equal_or_qAFresh by blast
thus ?thesis
unfolding alphaAbs_all_distinct_qAFresh_def alphaAbs_all_equal_or_qAFresh_def by auto
qed
corollary alphaAbs_qAbs_imp_all_distinct_qAFresh:
assumes "qGood X" and "(qAbs xs x X $= qAbs xs' x' X')"
shows
"(xs = xs' ∧
(∀ y. y ∉ {x,x'} ∧ qAFresh xs y X ∧ qAFresh xs y X' ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
proof-
have "alphaAbs_all_distinct_qAFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_imp_alphaAbs_all_distinct_qAFresh by blast
thus ?thesis unfolding alphaAbs_all_distinct_qAFresh_def .
qed
lemma alphaAbs_qAbs_iff_alphaAbs_all_distinct_qAFresh:
assumes "qGood X" and "qGood X'"
shows "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_all_distinct_qAFresh xs x X xs' x' X'"
proof-
let ?Left = "qAbs xs x X $= qAbs xs' x' X'"
let ?MiddleEx = "alphaAbs_ex_distinct_qAFresh xs x X xs' x' X'"
let ?MiddleAll = "alphaAbs_all_distinct_qAFresh xs x X xs' x' X'"
let ?Right = "alphaAbs_all_distinct_qAFresh xs x X xs' x' X'"
have "?Left ⟹ ?Right"
using assms alphaAbs_qAbs_imp_alphaAbs_all_distinct_qAFresh by blast
moreover have "?Right ⟹ ?MiddleAll"
unfolding alphaAbs_all_distinct_qAFresh_def alphaAbs_all_distinct_qAFresh_def by auto
moreover have "?MiddleAll ⟹ ?MiddleEx"
using assms alphaAbs_weakestAll_imp_strongestEx by fastforce
moreover have "?MiddleEx ⟹ ?Left"
using assms alphaAbs_qAbs_iff_alphaAbs_ex_distinct_qAFresh[of _ _ X] by fastforce
ultimately show ?thesis by blast
qed
corollary alphaAbs_qAbs_iff_all_distinct_qAFresh:
assumes "qGood X" and "qGood X'"
shows "(qAbs xs x X $= qAbs xs' x' X') =
(xs = xs' ∧
(∀ y. y ∉ {x,x'} ∧ qAFresh xs y X ∧ qAFresh xs y X' ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
proof-
have "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_all_distinct_qAFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_iff_alphaAbs_all_distinct_qAFresh by blast
thus ?thesis unfolding alphaAbs_all_distinct_qAFresh_def .
qed
subsubsection‹Then for ``qFresh"›
definition alphaAbs_ex_equal_or_qFresh
where
"alphaAbs_ex_equal_or_qFresh xs x X xs' x' X' ==
(xs = xs' ∧
(∃ y. (y = x ∨ qFresh xs y X) ∧ (y = x' ∨ qFresh xs y X') ∧
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
definition alphaAbs_ex_qFresh
where
"alphaAbs_ex_qFresh xs x X xs' x' X' ==
(xs = xs' ∧
(∃ y. qFresh xs y X ∧ qFresh xs y X' ∧
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
definition alphaAbs_ex_distinct_qFresh
where
"alphaAbs_ex_distinct_qFresh xs x X xs' x' X' ==
(xs = xs' ∧
(∃ y. y ∉ {x,x'} ∧ qFresh xs y X ∧ qFresh xs y X' ∧
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
definition alphaAbs_all_equal_or_qFresh
where
"alphaAbs_all_equal_or_qFresh xs x X xs' x' X' ==
(xs = xs' ∧
(∀ y. (y = x ∨ qFresh xs y X) ∧ (y = x' ∨ qFresh xs y X') ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
definition alphaAbs_all_qFresh
where
"alphaAbs_all_qFresh xs x X xs' x' X' ==
(xs = xs' ∧
(∀ y. qFresh xs y X ∧ qFresh xs y X' ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
definition alphaAbs_all_distinct_qFresh
where
"alphaAbs_all_distinct_qFresh xs x X xs' x' X' ==
(xs = xs' ∧
(∀ y. y ∉ {x,x'} ∧ qFresh xs y X ∧ qFresh xs y X' ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
lemma alphaAbs_ex_equal_or_qAFresh_imp_qFresh:
"alphaAbs_ex_equal_or_qAFresh xs x X xs' x' X' ⟹
alphaAbs_ex_equal_or_qFresh xs x X xs' x' X'"
unfolding alphaAbs_ex_equal_or_qAFresh_def alphaAbs_ex_equal_or_qFresh_def
using qAFresh_imp_qFresh[of _ _ X] qAFresh_imp_qFresh[of _ _ X'] by blast
lemma alphaAbs_ex_distinct_qAFresh_imp_qFresh:
"alphaAbs_ex_distinct_qAFresh xs x X xs' x' X' ⟹
alphaAbs_ex_distinct_qFresh xs x X xs' x' X'"
unfolding alphaAbs_ex_distinct_qAFresh_def alphaAbs_ex_distinct_qFresh_def
using qAFresh_imp_qFresh[of _ _ X] qAFresh_imp_qFresh[of _ _ X'] by blast
lemma alphaAbs_ex_qAFresh_imp_qFresh:
"alphaAbs_ex_qAFresh xs x X xs' x' X' ⟹
alphaAbs_ex_qFresh xs x X xs' x' X'"
unfolding alphaAbs_ex_qAFresh_def alphaAbs_ex_qFresh_def
using qAFresh_imp_qFresh[of _ _ X] qAFresh_imp_qFresh[of _ _ X'] by blast
lemma alphaAbs_all_equal_or_qFresh_imp_qAFresh:
"alphaAbs_all_equal_or_qFresh xs x X xs' x' X' ⟹
alphaAbs_all_equal_or_qAFresh xs x X xs' x' X'"
unfolding alphaAbs_all_equal_or_qAFresh_def alphaAbs_all_equal_or_qFresh_def
using qAFresh_imp_qFresh[of _ _ X] qAFresh_imp_qFresh[of _ _ X'] by blast
lemma alphaAbs_all_distinct_qFresh_imp_qAFresh:
"alphaAbs_all_distinct_qFresh xs x X xs' x' X' ⟹
alphaAbs_all_distinct_qAFresh xs x X xs' x' X'"
using qAFresh_imp_qFresh
unfolding alphaAbs_all_distinct_qAFresh_def alphaAbs_all_distinct_qFresh_def by fastforce
lemma alphaAbs_all_qFresh_imp_qAFresh:
"alphaAbs_all_qFresh xs x X xs' x' X' ⟹
alphaAbs_all_qAFresh xs x X xs' x' X'"
using qAFresh_imp_qFresh
unfolding alphaAbs_all_qAFresh_def alphaAbs_all_qFresh_def by fastforce
lemma alphaAbs_ex_equal_or_qFresh_imp_alphaAbs_qAbs:
assumes GOOD: "qGood X" and "alphaAbs_ex_equal_or_qFresh xs x X xs' x' X'"
shows "qAbs xs x X $= qAbs xs' x' X'"
proof-
obtain y where xs: "xs = xs'" and
yEqFresh: "(y = x ∨ qFresh xs y X) ∧ (y = x' ∨ qFresh xs y X')" and
alphaXX'yx: "(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)"
using assms unfolding alphaAbs_ex_equal_or_qFresh_def by blast
have "∃ Y. X #= Y ∧ (y = x ∨ qAFresh xs y Y)"
proof(cases "y = x")
assume Case1: "y = x" hence "X #= X" using GOOD alpha_refl by auto
thus ?thesis using Case1 by fastforce
next
assume Case2: "y ≠ x" hence "qFresh xs y X" using yEqFresh by blast
then obtain Y where "X #= Y" and "qAFresh xs y Y"
using GOOD qFresh_imp_ex_qAFresh1 by fastforce
thus ?thesis by auto
qed
then obtain Y where alphaXY: "X #= Y" and yEqAFresh: "y = x ∨ qAFresh xs y Y" by blast
hence "(X #[[y ∧ x]]_xs) #= (Y #[[y ∧ x]]_xs)"
using GOOD qSwap_preserves_alpha by fastforce
hence alphaYXyx: "(Y #[[y ∧ x]]_xs) #= (X #[[y ∧ x]]_xs)" using alpha_sym by auto
have goodY: "qGood Y" using alphaXY GOOD alpha_preserves_qGood by auto
hence goodYyx: "qGood(Y #[[y ∧ x]]_xs)" using qSwap_preserves_qGood by auto
have good': "qGood X'"
using GOOD alphaXX'yx alpha_qSwap_preserves_qGood by fastforce
have "∃ Y'. X' #= Y' ∧ (y = x' ∨ qAFresh xs y Y')"
proof(cases "y = x'")
assume Case1: "y = x'" hence "X' #= X'" using good' alpha_refl by auto
thus ?thesis using Case1 by fastforce
next
assume Case2: "y ≠ x'" hence "qFresh xs y X'" using yEqFresh by blast
then obtain Y' where "X' #= Y'" and "qAFresh xs y Y'"
using good' qFresh_imp_ex_qAFresh1 by fastforce
thus ?thesis by auto
qed
then obtain Y' where alphaX'Y': "X' #= Y'" and
yEqAFresh': "y = x' ∨ qAFresh xs y Y'" by blast
hence "(X' #[[y ∧ x']]_xs) #= (Y' #[[y ∧ x']]_xs)"
using good' by (auto simp add: qSwap_preserves_alpha)
hence "(Y #[[y ∧ x]]_xs) #= (Y' #[[y ∧ x']]_xs)"
using goodYyx alphaYXyx alphaXX'yx alpha_trans by blast
hence "alphaAbs_ex_equal_or_qAFresh xs x Y xs x' Y'"
unfolding alphaAbs_ex_equal_or_qAFresh_def using yEqAFresh yEqAFresh' by fastforce
hence "qAbs xs x Y $= qAbs xs x' Y'"
using goodY alphaAbs_qAbs_iff_alphaAbs_ex_equal_or_qAFresh[of Y xs x xs] by fastforce
moreover have "qAbs xs x X $= qAbs xs x Y"
using alphaXY GOOD qAbs_preserves_alpha by fastforce
moreover
{have 1: "Y' #= X'" using alphaX'Y' alpha_sym by auto
hence "qGood Y'" using good' alpha_preserves_qGood by auto
hence "qAbs xs x' Y' $= qAbs xs x' X'"
using 1 GOOD qAbs_preserves_alpha by fastforce
}
moreover have "qGoodAbs(qAbs xs x X)" using GOOD by simp
ultimately have "qAbs xs x X $= qAbs xs x' X'"
using alphaAbs_trans_twice by blast
thus ?thesis using xs by simp
qed
lemma alphaAbs_qAbs_iff_alphaAbs_ex_equal_or_qFresh:
assumes GOOD: "qGood X"
shows "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_ex_equal_or_qFresh xs x X xs' x' X'"
proof-
let ?Left = "qAbs xs x X $= qAbs xs' x' X'"
let ?Middle = "alphaAbs_ex_equal_or_qAFresh xs x X xs' x' X'"
let ?Right = "alphaAbs_ex_equal_or_qFresh xs x X xs' x' X'"
have "?Right ⟹ ?Left"
using assms alphaAbs_ex_equal_or_qFresh_imp_alphaAbs_qAbs by blast
moreover have "?Left ⟹ ?Middle"
using assms alphaAbs_qAbs_iff_alphaAbs_ex_equal_or_qAFresh by blast
moreover have "?Middle ⟹ ?Right" using
alphaAbs_ex_equal_or_qAFresh_imp_qFresh by fastforce
ultimately show ?thesis by blast
qed
corollary alphaAbs_qAbs_iff_ex_equal_or_qFresh:
assumes GOOD: "qGood X"
shows "(qAbs xs x X $= qAbs xs' x' X') =
(xs = xs' ∧
(∃ y. (y = x ∨ qFresh xs y X) ∧ (y = x' ∨ qFresh xs y X') ∧
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
proof-
have "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_ex_equal_or_qFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_iff_alphaAbs_ex_equal_or_qFresh by blast
thus ?thesis unfolding alphaAbs_ex_equal_or_qFresh_def .
qed
lemma alphaAbs_qAbs_iff_alphaAbs_ex_qFresh:
assumes GOOD: "qGood X"
shows "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_ex_qFresh xs x X xs' x' X'"
proof-
let ?Left = "qAbs xs x X $= qAbs xs' x' X'"
let ?Middle1 = "alphaAbs_ex_qAFresh xs x X xs' x' X'"
let ?Middle2 = "alphaAbs_ex_equal_or_qFresh xs x X xs' x' X'"
let ?Right = "alphaAbs_ex_qFresh xs x X xs' x' X'"
have "?Left ⟹ ?Middle1" unfolding alphaAbs_ex_qAFresh_def by auto
moreover have "?Middle1 ⟹ ?Right" using alphaAbs_ex_qAFresh_imp_qFresh by fastforce
moreover have "?Right ⟹ ?Middle2"
unfolding alphaAbs_ex_qFresh_def alphaAbs_ex_equal_or_qFresh_def by auto
moreover have "?Middle2 ⟹ ?Left"
using assms alphaAbs_ex_equal_or_qFresh_imp_alphaAbs_qAbs by fastforce
ultimately show ?thesis by blast
qed
corollary alphaAbs_qAbs_iff_ex_qFresh:
assumes GOOD: "qGood X"
shows "(qAbs xs x X $= qAbs xs' x' X') =
(xs = xs' ∧
(∃ y. qFresh xs y X ∧ qFresh xs y X' ∧
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
proof-
have "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_ex_qFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_iff_alphaAbs_ex_qFresh by blast
thus ?thesis unfolding alphaAbs_ex_qFresh_def .
qed
lemma alphaAbs_qAbs_iff_alphaAbs_ex_distinct_qFresh:
assumes GOOD: "qGood X"
shows "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_ex_distinct_qFresh xs x X xs' x' X'"
proof-
let ?Left = "qAbs xs x X $= qAbs xs' x' X'"
let ?Middle1 = "alphaAbs_ex_distinct_qAFresh xs x X xs' x' X'"
let ?Middle2 = "alphaAbs_ex_equal_or_qFresh xs x X xs' x' X'"
let ?Right = "alphaAbs_ex_distinct_qFresh xs x X xs' x' X'"
have "?Left ⟹ ?Middle1" unfolding alphaAbs_ex_distinct_qAFresh_def by auto
moreover have "?Middle1 ⟹ ?Right" using alphaAbs_ex_distinct_qAFresh_imp_qFresh by fastforce
moreover have "?Right ⟹ ?Middle2"
unfolding alphaAbs_ex_distinct_qFresh_def alphaAbs_ex_equal_or_qFresh_def by auto
moreover have "?Middle2 ⟹ ?Left"
using assms alphaAbs_ex_equal_or_qFresh_imp_alphaAbs_qAbs by fastforce
ultimately show ?thesis by blast
qed
corollary alphaAbs_qAbs_iff_ex_distinct_qFresh:
assumes GOOD: "qGood X"
shows "(qAbs xs x X $= qAbs xs' x' X') =
(xs = xs' ∧
(∃ y. y ∉ {x, x'} ∧ qFresh xs y X ∧ qFresh xs y X' ∧
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
proof-
have "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_ex_distinct_qFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_iff_alphaAbs_ex_distinct_qFresh by blast
thus ?thesis unfolding alphaAbs_ex_distinct_qFresh_def .
qed
lemma alphaAbs_qAbs_imp_alphaAbs_all_equal_or_qFresh:
assumes "qGood X" and "qAbs xs x X $= qAbs xs' x' X'"
shows "alphaAbs_all_equal_or_qFresh xs x X xs' x' X'"
proof-
have "qGoodAbs(qAbs xs x X)" using assms by auto
hence "qGoodAbs(qAbs xs' x' X')" using assms alphaAbs_preserves_qGoodAbs by blast
hence GOOD: "qGood X ∧ qGood X'" using assms by auto
have xs: "xs = xs'" using assms by auto
show ?thesis
unfolding alphaAbs_all_equal_or_qFresh_def using xs
proof(intro conjI impI allI, simp)
fix y
assume yEqFresh: "(y = x ∨ qFresh xs y X) ∧ (y = x' ∨ qFresh xs y X')"
have "∃ Y. X #= Y ∧ (y = x ∨ qAFresh xs y Y)"
proof(cases "y = x")
assume Case1: "y = x" hence "X #= X" using GOOD alpha_refl by auto
thus ?thesis using Case1 by fastforce
next
assume Case2: "y ≠ x" hence "qFresh xs y X" using yEqFresh by blast
then obtain Y where "X #= Y" and "qAFresh xs y Y"
using GOOD qFresh_imp_ex_qAFresh1 by blast
thus ?thesis by auto
qed
then obtain Y where alphaXY: "X #= Y" and yEqAFresh: "y = x ∨ qAFresh xs y Y" by blast
hence alphaXYyx: "(X #[[y ∧ x]]_xs) #= (Y #[[y ∧ x]]_xs)"
using GOOD by (auto simp add: qSwap_preserves_alpha)
have goodY: "qGood Y" using GOOD alphaXY alpha_preserves_qGood by auto
have "∃ Y'. X' #= Y' ∧ (y = x' ∨ qAFresh xs y Y')"
proof(cases "y = x'")
assume Case1: "y = x'" hence "X' #= X'" using GOOD alpha_refl by auto
thus ?thesis using Case1 by fastforce
next
assume Case2: "y ≠ x'" hence "qFresh xs y X'" using yEqFresh by blast
then obtain Y' where "X' #= Y'" and "qAFresh xs y Y'"
using GOOD qFresh_imp_ex_qAFresh1 by blast
thus ?thesis by auto
qed
then obtain Y' where alphaX'Y': "X' #= Y'" and
yEqAFresh': "y = x' ∨ qAFresh xs y Y'" by blast
hence "(X' #[[y ∧ x']]_xs) #= (Y' #[[y ∧ x']]_xs)"
using GOOD by (auto simp add: qSwap_preserves_alpha)
hence alphaY'X'yx': "(Y' #[[y ∧ x']]_xs) #= (X' #[[y ∧ x']]_xs)" using alpha_sym by auto
have goodY': "qGood Y'" using GOOD alphaX'Y' alpha_preserves_qGood by auto
have 1: "Y #= X" using alphaXY alpha_sym by auto
hence "qGood Y" using GOOD alpha_preserves_qGood by auto
hence 2: "qAbs xs x Y $= qAbs xs x X"
using 1 GOOD qAbs_preserves_alpha by blast
moreover have "qAbs xs x' X' $= qAbs xs x' Y'"
using alphaX'Y' GOOD qAbs_preserves_alpha by blast
moreover
{have "qGoodAbs(qAbs xs x X)" using GOOD by simp
hence "qGoodAbs(qAbs xs x Y)" using 2 alphaAbs_preserves_qGoodAbs by fastforce
}
ultimately have "qAbs xs x Y $= qAbs xs x' Y'"
using assms xs alphaAbs_trans_twice by blast
hence "alphaAbs_all_equal_or_qAFresh xs x Y xs x' Y'"
using goodY goodY' alphaAbs_qAbs_iff_alphaAbs_all_equal_or_qAFresh by blast
hence "(Y #[[y ∧ x]]_xs) #= (Y' #[[y ∧ x']]_xs)"
unfolding alphaAbs_all_equal_or_qAFresh_def
using yEqAFresh yEqAFresh' by auto
moreover have "qGood (X #[[y ∧ x]]_xs)" using GOOD qSwap_preserves_qGood by auto
ultimately show "(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)"
using alphaXYyx alphaY'X'yx' alpha_trans_twice by blast
qed
qed
corollary alphaAbs_qAbs_imp_all_equal_or_qFresh:
assumes "qGood X" and "(qAbs xs x X $= qAbs xs' x' X')"
shows
"(xs = xs' ∧
(∀ y. (y = x ∨ qFresh xs y X) ∧ (y = x' ∨ qFresh xs y X') ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
proof-
have "alphaAbs_all_equal_or_qFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_imp_alphaAbs_all_equal_or_qFresh by blast
thus ?thesis unfolding alphaAbs_all_equal_or_qFresh_def .
qed
lemma alphaAbs_qAbs_iff_alphaAbs_all_equal_or_qFresh:
assumes "qGood X" and "qGood X'"
shows "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_all_equal_or_qFresh xs x X xs' x' X'"
proof-
let ?Left = "(qAbs xs x X $= qAbs xs' x' X')"
let ?Middle = "alphaAbs_all_equal_or_qAFresh xs x X xs' x' X'"
let ?Right = "alphaAbs_all_equal_or_qFresh xs x X xs' x' X'"
have "?Left ⟹ ?Right"
using assms alphaAbs_qAbs_imp_alphaAbs_all_equal_or_qFresh by blast
moreover have "?Right ⟹ ?Middle"
using alphaAbs_all_equal_or_qFresh_imp_qAFresh by fastforce
moreover have "?Middle ==> ?Left"
using assms alphaAbs_qAbs_iff_alphaAbs_all_equal_or_qAFresh by blast
ultimately show ?thesis by blast
qed
corollary alphaAbs_qAbs_iff_all_equal_or_qFresh:
assumes "qGood X" and "qGood X'"
shows "(qAbs xs x X $= qAbs xs' x' X') =
(xs = xs' ∧
(∀ y. (y = x ∨ qFresh xs y X) ∧ (y = x' ∨ qFresh xs y X') ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
proof-
have "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_all_equal_or_qFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_iff_alphaAbs_all_equal_or_qFresh by blast
thus ?thesis unfolding alphaAbs_all_equal_or_qFresh_def .
qed
lemma alphaAbs_qAbs_imp_alphaAbs_all_qFresh:
assumes "qGood X" and "qAbs xs x X $= qAbs xs' x' X'"
shows "alphaAbs_all_qFresh xs x X xs' x' X'"
proof-
let ?Left = "(qAbs xs x X $= qAbs xs' x' X')"
let ?Middle = "alphaAbs_all_equal_or_qFresh xs x X xs' x' X'"
let ?Right = "alphaAbs_all_qFresh xs x X xs' x' X'"
have "?Left ⟹ ?Middle"
using assms alphaAbs_qAbs_imp_alphaAbs_all_equal_or_qFresh by blast
moreover have "?Middle ⟹ ?Right"
unfolding alphaAbs_all_equal_or_qFresh_def alphaAbs_all_qFresh_def by auto
ultimately show ?thesis using assms by blast
qed
corollary alphaAbs_qAbs_imp_all_qFresh:
assumes "qGood X" and "(qAbs xs x X $= qAbs xs' x' X')"
shows
"(xs = xs' ∧
(∀ y. qFresh xs y X ∧ qFresh xs y X' ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
proof-
have "alphaAbs_all_qFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_imp_alphaAbs_all_qFresh by blast
thus ?thesis unfolding alphaAbs_all_qFresh_def .
qed
lemma alphaAbs_qAbs_iff_alphaAbs_all_qFresh:
assumes "qGood X" and "qGood X'"
shows "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_all_qFresh xs x X xs' x' X'"
proof-
let ?Left = "(qAbs xs x X $= qAbs xs' x' X')"
let ?Middle = "alphaAbs_all_qAFresh xs x X xs' x' X'"
let ?Right = "alphaAbs_all_qFresh xs x X xs' x' X'"
have "?Left ⟹ ?Right"
using assms alphaAbs_qAbs_imp_alphaAbs_all_qFresh by blast
moreover have "?Right ⟹ ?Middle"
using alphaAbs_all_qFresh_imp_qAFresh by fastforce
moreover have "?Middle ⟹ ?Left"
using assms alphaAbs_qAbs_iff_alphaAbs_all_qAFresh by blast
ultimately show ?thesis by blast
qed
corollary alphaAbs_qAbs_iff_all_qFresh:
assumes "qGood X" and "qGood X'"
shows "(qAbs xs x X $= qAbs xs' x' X') =
(xs = xs' ∧
(∀ y. qFresh xs y X ∧ qFresh xs y X' ⟶
(X #[[y ∧ x]]_xs) #= (X' #[[y ∧ x']]_xs)))"
proof-
have "(qAbs xs x X $= qAbs xs' x' X') =
alphaAbs_all_qFresh xs x X xs' x' X'"
using assms alphaAbs_qAbs_iff_alphaAbs_all_qFresh by blast
thus ?thesis unfolding alphaAbs_all_qFresh_def .
qed
end
end
Theory QuasiTerms_Environments_Substitution
section ‹Environments and Substitution for Quasi-Terms›
theory QuasiTerms_Environments_Substitution
imports QuasiTerms_PickFresh_Alpha
begin
text‹Inside this theory, since anyway all the interesting properties hold only
modulo alpha, we forget completely about qAFresh and use only qFresh.›
text‹In this section we define, for quasi-terms, parallel substitution according to
{\em environments}.
This is the most general kind of substitution -- an environment, i.e., a partial
map from variables
to quasi-terms, indicates which quasi-term (if any) to be substituted for each
variable; substitution
is then applied to a subject quasi-term and an environment. In order to ``keep up"
with the notion
of good quasi-term, we define good environments and show that substitution
preserves goodness. Since,
unlike swapping, substitution does not behave well w.r.t. quasi-terms
(but only w.r.t. terms, i.e., to alpha-equivalence classes),
here we prove the minimum amount of properties required for properly lifting
parallel substitution to terms. Then compositionality properties
of parallel substitution will be proved directly for terms.
›
subsection ‹Environments›
type_synonym ('index,'bindex,'varSort,'var,'opSym)qEnv =
"'varSort ⇒ 'var ⇒ ('index,'bindex,'varSort,'var,'opSym)qTerm option"
context FixVars
begin
definition qGoodEnv :: "('index,'bindex,'varSort,'var,'opSym)qEnv ⇒ bool"
where
"qGoodEnv rho ==
(∀ xs. liftAll qGood (rho xs)) ∧
(∀ ys. |{y. rho ys y ≠ None}| <o |UNIV :: 'var set| )"
definition qFreshEnv where
"qFreshEnv zs z rho ==
rho zs z = None ∧ (∀ xs. liftAll (qFresh zs z) (rho xs))"
definition alphaEnv where
"alphaEnv =
{(rho,rho'). ∀ xs. sameDom (rho xs) (rho' xs) ∧
liftAll2 (λX X'. X #= X') (rho xs) (rho' xs)}"
abbreviation alphaEnv_abbrev ::
"('index,'bindex,'varSort,'var,'opSym)qEnv ⇒
('index,'bindex,'varSort,'var,'opSym)qEnv ⇒ bool" (infix "&=" 50)
where
"rho &= rho' == (rho,rho') ∈ alphaEnv"
definition pickQFreshEnv
where
"pickQFreshEnv xs V XS Rho ==
pickQFresh xs (V ∪ (⋃ rho ∈ Rho. {x. rho xs x ≠ None}))
(XS ∪ (⋃ rho ∈ Rho. {X. ∃ ys y. rho ys y = Some X}))"
lemma qGoodEnv_imp_card_of_qTerm:
assumes "qGoodEnv rho"
shows "|{X. ∃ y. rho ys y = Some X}| <o |UNIV :: 'var set|"
proof-
let ?rel = "{(y,X). rho ys y = Some X}"
let ?Left = "{X. ∃ y. rho ys y = Some X}"
let ?Left' = "{y. ∃ X. rho ys y = Some X}"
have "⋀ y X X'. (y,X) ∈ ?rel ∧ (y,X') ∈ ?rel ⟶ X = X'" by force
hence "|?Left| ≤o |?Left'|" using card_of_inj_rel[of ?rel] by auto
moreover have "|?Left'| <o |UNIV :: 'var set|" using assms unfolding qGoodEnv_def by auto
ultimately show ?thesis using ordLeq_ordLess_trans by blast
qed
lemma qGoodEnv_imp_card_of_qTerm2:
assumes "qGoodEnv rho"
shows "|{X. ∃ ys y. rho ys y = Some X}| <o |UNIV :: 'var set|"
proof-
let ?Left = "{X. ∃ ys y. rho ys y = Some X}"
let ?F = "λ ys. {X. ∃ y. rho ys y = Some X}"
have "?Left = (⋃ ys. ?F ys)" by auto
moreover have "∀ ys. |?F ys| <o |UNIV :: 'var set|"
using assms qGoodEnv_imp_card_of_qTerm by auto
ultimately show ?thesis
using var_regular_INNER varSort_lt_var_INNER by(force simp add: regular_UNION)
qed
lemma qGoodEnv_iff:
"qGoodEnv rho =
((∀ xs. liftAll qGood (rho xs)) ∧
(∀ ys. |{y. rho ys y ≠ None}| <o |UNIV :: 'var set| ) ∧
|{X. ∃ ys y. rho ys y = Some X}| <o |UNIV :: 'var set| )"
unfolding qGoodEnv_def apply auto
apply(rule qGoodEnv_imp_card_of_qTerm2) unfolding qGoodEnv_def by simp
lemma alphaEnv_refl:
"qGoodEnv rho ⟹ rho &= rho"
using alpha_refl
unfolding alphaEnv_def qGoodEnv_def liftAll_def liftAll2_def sameDom_def by fastforce
lemma alphaEnv_sym:
"rho &= rho' ⟹ rho' &= rho"
using alpha_sym unfolding alphaEnv_def liftAll2_def sameDom_def by fastforce
lemma alphaEnv_trans:
assumes good: "qGoodEnv rho" and
alpha1: "rho &= rho'" and alpha2: "rho' &= rho''"
shows "rho &= rho''"
using assms unfolding alphaEnv_def
apply(auto)
using sameDom_trans apply blast
unfolding liftAll2_def proof(auto)
fix xs x X X''
assume rho: "rho xs x = Some X" and rho'': "rho'' xs x = Some X''"
moreover have "(rho xs x = None) = (rho' xs x = None)"
using alpha1 unfolding alphaEnv_def sameDom_def by auto
ultimately obtain X' where rho': "rho' xs x = Some X'" by auto
hence "X #= X'" using alpha1 rho unfolding alphaEnv_def liftAll2_def by auto
moreover have "X' #= X''"
using alpha2 rho' rho'' unfolding alphaEnv_def liftAll2_def by auto
moreover have "qGood X" using good rho unfolding qGoodEnv_def liftAll_def by auto
ultimately show "X #= X''" using alpha_trans by blast
qed
lemma pickQFreshEnv_card_of:
assumes Vvar: "|V| <o |UNIV :: 'var set|" and XSvar: "|XS| <o |UNIV :: 'var set|" and
good: "∀ X ∈ XS. qGood X" and
Rhovar: "|Rho| <o |UNIV :: 'var set|" and RhoGood: "∀ rho ∈ Rho. qGoodEnv rho"
shows
"pickQFreshEnv xs V XS Rho ∉ V ∧
(∀ X ∈ XS. qFresh xs (pickQFreshEnv xs V XS Rho) X) ∧
(∀ rho ∈ Rho. qFreshEnv xs (pickQFreshEnv xs V XS Rho) rho)"
proof-
let ?z =" pickQFreshEnv xs V XS Rho"
let ?V2 = "⋃ rho ∈ Rho. {x. rho xs x ≠ None}" let ?W = "V ∪ ?V2"
let ?XS2 = "⋃ rho ∈ Rho. {X. ∃ ys y. rho ys y = Some X}" let ?YS = "XS ∪ ?XS2"
have "|?W| <o |UNIV :: 'var set|"
proof-
have "∀ rho ∈ Rho. |{x. rho xs x ≠ None}| <o |UNIV :: 'var set|"
using RhoGood unfolding qGoodEnv_iff using qGoodEnv_iff by auto
hence "|?V2| <o |UNIV :: 'var set|"
using var_regular_INNER Rhovar by (auto simp add: regular_UNION)
thus ?thesis using var_infinite_INNER Vvar card_of_Un_ordLess_infinite by auto
qed
moreover have "|?YS| <o |UNIV :: 'var set|"
proof-
have "∀ rho ∈ Rho. |{X. ∃ ys y. rho ys y = Some X}| <o |UNIV :: 'var set|"
using RhoGood unfolding qGoodEnv_iff by auto
hence "|?XS2| <o |UNIV :: 'var set|"
using var_regular_INNER Rhovar by (auto simp add: regular_UNION)
thus ?thesis using var_infinite_INNER XSvar card_of_Un_ordLess_infinite by auto
qed
moreover have "∀ Y ∈ ?YS. qGood Y"
using good RhoGood unfolding qGoodEnv_iff liftAll_def by blast
ultimately
have "?z ∉ ?W ∧ (∀ Y ∈ ?YS. qFresh xs ?z Y)"
unfolding pickQFreshEnv_def using pickQFresh_card_of[of ?W ?YS] by auto
thus ?thesis unfolding qFreshEnv_def liftAll_def by(auto)
qed
lemma pickQFreshEnv:
assumes Vvar: "|V| <o |UNIV :: 'var set| ∨ finite V"
and XSvar: "|XS| <o |UNIV :: 'var set| ∨ finite XS"
and good: "∀ X ∈ XS. qGood X"
and Rhovar: "|Rho| <o |UNIV :: 'var set| ∨ finite Rho"
and RhoGood: "∀ rho ∈ Rho. qGoodEnv rho"
shows
"pickQFreshEnv xs V XS Rho ∉ V ∧
(∀ X ∈ XS. qFresh xs (pickQFreshEnv xs V XS Rho) X) ∧
(∀ rho ∈ Rho. qFreshEnv xs (pickQFreshEnv xs V XS Rho) rho)"
proof-
have 1: "|V| <o |UNIV :: 'var set| ∧ |XS| <o |UNIV :: 'var set| ∧ |Rho| <o |UNIV :: 'var set|"
using assms var_infinite_INNER by(auto simp add: finite_ordLess_infinite2)
show ?thesis
apply(rule pickQFreshEnv_card_of)
using assms 1 by auto
qed
corollary obtain_qFreshEnv:
fixes XS::"('index,'bindex,'varSort,'var,'opSym)qTerm set" and
Rho::"('index,'bindex,'varSort,'var,'opSym)qEnv set" and rho
assumes Vvar: "|V| <o |UNIV :: 'var set| ∨ finite V"
and XSvar: "|XS| <o |UNIV :: 'var set| ∨ finite XS"
and good: "∀ X ∈ XS. qGood X"
and Rhovar: "|Rho| <o |UNIV :: 'var set| ∨ finite Rho"
and RhoGood: "∀ rho ∈ Rho. qGoodEnv rho"
shows
"∃ z. z ∉ V ∧
(∀ X ∈ XS. qFresh xs z X) ∧ (∀ rho ∈ Rho. qFreshEnv xs z rho)"
apply(rule exI[of _ "pickQFreshEnv xs V XS Rho"])
using assms by(rule pickQFreshEnv)
subsection ‹Parallel substitution›
definition aux_qPsubst_ignoreFirst ::
"('index,'bindex,'varSort,'var,'opSym)qEnv * ('index,'bindex,'varSort,'var,'opSym)qTerm +
('index,'bindex,'varSort,'var,'opSym)qEnv * ('index,'bindex,'varSort,'var,'opSym)qAbs
⇒ ('index,'bindex,'varSort,'var,'opSym)qTermItem"
where
"aux_qPsubst_ignoreFirst K ==
case K of Inl (rho,X) ⇒ termIn X
|Inr (rho,A) ⇒ absIn A"
lemma aux_qPsubst_ignoreFirst_qTermLessQSwapped_wf:
"wf(inv_image qTermQSwappedLess aux_qPsubst_ignoreFirst)"
using qTermQSwappedLess_wf wf_inv_image by auto
function
qPsubst ::
"('index,'bindex,'varSort,'var,'opSym)qEnv ⇒ ('index,'bindex,'varSort,'var,'opSym)qTerm ⇒
('index,'bindex,'varSort,'var,'opSym)qTerm"
and
qPsubstAbs ::
"('index,'bindex,'varSort,'var,'opSym)qEnv ⇒ ('index,'bindex,'varSort,'var,'opSym)qAbs ⇒
('index,'bindex,'varSort,'var,'opSym)qAbs"
where
"qPsubst rho (qVar xs x) = (case rho xs x of None ⇒ qVar xs x| Some X ⇒ X)"
|
"qPsubst rho (qOp delta inp binp) =
qOp delta (lift (qPsubst rho) inp) (lift (qPsubstAbs rho) binp)"
|
"qPsubstAbs rho (qAbs xs x X) =
(let x' = pickQFreshEnv xs {x} {X} {rho} in qAbs xs x' (qPsubst rho (X #[[x' ∧ x]]_xs)))"
by(pat_completeness, auto)
termination
apply(relation "inv_image qTermQSwappedLess aux_qPsubst_ignoreFirst")
apply(simp add: aux_qPsubst_ignoreFirst_qTermLessQSwapped_wf)
by(auto simp add: qTermQSwappedLess_def qTermLess_modulo_def
aux_qPsubst_ignoreFirst_def qSwap_qSwapped)
abbreviation qPsubst_abbrev ::
"('index,'bindex,'varSort,'var,'opSym)qTerm ⇒ ('index,'bindex,'varSort,'var,'opSym)qEnv ⇒
('index,'bindex,'varSort,'var,'opSym)qTerm" ("_ #[[_]]")
where "X #[[rho]] == qPsubst rho X"
abbreviation qPsubstAbs_abbrev ::
"('index,'bindex,'varSort,'var,'opSym)qAbs ⇒ ('index,'bindex,'varSort,'var,'opSym)qEnv ⇒
('index,'bindex,'varSort,'var,'opSym)qAbs" ("_ $[[_]]")
where "A $[[rho]] == qPsubstAbs rho A"
lemma qPsubstAll_preserves_qGoodAll:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and rho
assumes GOOD_ENV: "qGoodEnv rho"
shows
"(qGood X ⟶ qGood (X #[[rho]])) ∧ (qGoodAbs A ⟶ qGoodAbs (A $[[rho]]))"
proof(induction rule: qTerm_induct[of _ _ X A])
case (Var xs x)
show ?case
using GOOD_ENV unfolding qGoodEnv_iff liftAll_def
by(cases "rho xs x", auto)
next
case (Op delta inp binp)
show ?case proof safe
assume g: "qGood (qOp delta inp binp)"
hence 0: "liftAll qGood (lift (qPsubst rho) inp) ∧
liftAll qGoodAbs (lift (qPsubstAbs rho) binp)"
using Op unfolding liftAll_lift_comp comp_def
by (simp_all add: Let_def liftAll_mp)
have "{i. lift (qPsubst rho) inp i ≠ None} = {i. inp i ≠ None} ∧
{i. lift (qPsubstAbs rho) binp i ≠ None} = {i. binp i ≠ None}"
by simp (meson lift_Some)
hence "|{i. ∃y. lift (qPsubst rho) inp i = Some y}| <o |UNIV:: 'var set|"
and "|{i. ∃y. lift (qPsubstAbs rho) binp i = Some y}| <o |UNIV:: 'var set|"
using g by (auto simp: liftAll_def)
thus "qGood qOp delta inp binp #[[rho]]" using 0 by simp
qed
next
case (Abs xs x X)
show ?case proof safe
assume g: "qGoodAbs (qAbs xs x X)"
let ?x' = "pickQFreshEnv xs {x} {X} {rho}" let ?X' = "X #[[?x' ∧ x]]_xs"
have "qGood ?X'" using g qSwap_preserves_qGood by auto
moreover have "(X,?X') ∈ qSwapped" using qSwap_qSwapped by fastforce
ultimately have "qGood (qPsubst rho ?X')" using Abs.IH by simp
thus "qGoodAbs ((qAbs xs x X) $[[rho]])" by (simp add: Let_def)
qed
qed
corollary qPsubst_preserves_qGood:
"⟦qGoodEnv rho; qGood X⟧ ⟹ qGood (X #[[rho]])"
using qPsubstAll_preserves_qGoodAll by auto
corollary qPsubstAbs_preserves_qGoodAbs:
"⟦qGoodEnv rho; qGoodAbs A⟧ ⟹ qGoodAbs (A $[[rho]])"
using qPsubstAll_preserves_qGoodAll by auto
lemma qPsubstAll_preserves_qFreshAll:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and rho
assumes GOOD_ENV: "qGoodEnv rho"
shows
"(qFresh zs z X ⟶
(qGood X ∧ qFreshEnv zs z rho ⟶ qFresh zs z (X #[[rho]]))) ∧
(qFreshAbs zs z A ⟶
(qGoodAbs A ∧ qFreshEnv zs z rho ⟶ qFreshAbs zs z (A $[[rho]])))"
proof(induction rule: qTerm_induct[of _ _ X A])
case (Var xs x)
then show ?case
unfolding qFreshEnv_def liftAll_def by (cases "rho xs x") auto
next
case (Op delta inp binp)
thus ?case
by (auto simp add: lift_def liftAll_def qFreshEnv_def split: option.splits)
next
case (Abs xs x X)
show ?case proof safe
assume q: "qFreshAbs zs z (qAbs xs x X)"
"qGoodAbs (qAbs xs x X)" "qFreshEnv zs z rho"
let ?x' = "pickQFreshEnv xs {x} {X} {rho}" let ?X' = "X #[[?x' ∧ x]]_xs"
have x': "qFresh xs ?x' X ∧ qFreshEnv xs ?x' rho"
using q GOOD_ENV by(auto simp add: pickQFreshEnv)
hence goodX': "qGood ?X'" using q qSwap_preserves_qGood by auto
have XX': "(X,?X') ∈ qSwapped" using qSwap_qSwapped by fastforce
have "(zs = xs ∧ z = ?x') ∨ qFresh zs z (qPsubst rho ?X')"
by (meson qSwap_preserves_qFresh_distinct
Abs.IH(1) XX' goodX' q qAbs_alphaAbs_qSwap_qFresh qFreshAbs.simps
qFreshAbs_preserves_alphaAbs1 qSwap_preserves_qGood2 x')
thus "qFreshAbs zs z ((qAbs xs x X) $[[rho]])"
by simp (meson qFreshAbs.simps)+
qed
qed
lemma qPsubst_preserves_qFresh:
"⟦qGood X; qGoodEnv rho; qFresh zs z X; qFreshEnv zs z rho⟧
⟹ qFresh zs z (X #[[rho]])"
by(simp add: qPsubstAll_preserves_qFreshAll)
lemma qPsubstAbs_preserves_qFreshAbs:
"⟦qGoodAbs A; qGoodEnv rho; qFreshAbs zs z A; qFreshEnv zs z rho⟧
⟹ qFreshAbs zs z (A $[[rho]])"
by(simp add: qPsubstAll_preserves_qFreshAll)
text‹While in general we try to avoid proving facts in parallel,
here we seem to have no choice -- it is the first time we must use mutual
induction:›
lemma qPsubstAll_preserves_alphaAll_qSwapAll:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and
rho::"('index,'bindex,'varSort,'var,'opSym)qEnv"
assumes goodRho: "qGoodEnv rho"
shows
"(qGood X ⟶
(∀ Y. X #= Y ⟶ (X #[[rho]]) #= (Y #[[rho]])) ∧
(∀ xs z1 z2. qFreshEnv xs z1 rho ∧ qFreshEnv xs z2 rho ⟶
((X #[[z1 ∧ z2]]_xs) #[[rho]]) #= ((X #[[rho]]) #[[z1 ∧ z2]]_xs))) ∧
(qGoodAbs A ⟶
(∀ B. A $= B ⟶ (A $[[rho]]) $= (B $[[rho]])) ∧
(∀ xs z1 z2. qFreshEnv xs z1 rho ∧ qFreshEnv xs z2 rho ⟶
((A $[[z1 ∧ z2]]_xs) $[[rho]]) $= ((A $[[rho]]) $[[z1 ∧ z2]]_xs)))"
proof(induction rule: qGood_qTerm_induct_mutual)
case (Var1 xs x)
then show ?case
by (metis alpha_refl goodRho qGood.simps(1) qPsubst_preserves_qGood qVar_alpha_iff)
next
case (Var2 xs x)
show ?case proof safe
fix s::'sort and zs z1 z2
assume FreshEnv: "qFreshEnv zs z1 rho" "qFreshEnv zs z2 rho"
hence n: "rho zs z1 = None ∧ rho zs z2 = None" unfolding qFreshEnv_def by simp
let ?Left = "qPsubst rho ((qVar xs x) #[[z1 ∧ z2]]_zs)"
let ?Right = "(qPsubst rho (qVar xs x)) #[[z1 ∧ z2]]_zs"
have "qGood (qVar xs x)" by simp
hence "qGood ((qVar xs x) #[[z1 ∧ z2]]_zs)"
using qSwap_preserves_qGood by blast
hence goodLeft: "qGood ?Left" using goodRho qPsubst_preserves_qGood by blast
show "?Left #= ?Right"
proof(cases "rho xs x")
case None
hence "rho xs (x @xs[z1 ∧ z2]_zs) = None"
using n unfolding sw_def by auto
thus ?thesis using None by simp
next
case (Some X)
hence "xs ≠ zs ∨ x ∉ {z1,z2}" using n by auto
hence "(x @xs[z1 ∧ z2]_zs) = x" unfolding sw_def by auto
moreover
{have "qFresh zs z1 X ∧ qFresh zs z2 X"
using Some FreshEnv unfolding qFreshEnv_def liftAll_def by auto
moreover have "qGood X" using Some goodRho unfolding qGoodEnv_def liftAll_def by auto
ultimately have "X #= (X #[[z1 ∧ z2]]_zs)"
by(auto simp: alpha_qFresh_qSwap_id alpha_sym)
}
ultimately show ?thesis using Some by simp
qed
qed
next
case (Op1 delta inp binp)
show ?case proof safe
fix Y assume q: "qOp delta inp binp #= Y"
then obtain inp' binp' where Y: "Y = qOp delta inp' binp'" and
*: "(∀i. (inp i = None) = (inp' i = None)) ∧
(∀i. (binp i = None) = (binp' i = None))" and
**: "(∀i X X'. inp i = Some X ∧ inp' i = Some X' ⟶ X #= X') ∧
(∀i A A'. binp i = Some A ∧ binp' i = Some A' ⟶ A $= A')"
unfolding qOp_alpha_iff sameDom_def liftAll2_def by auto
show "(qOp delta inp binp) #[[rho]] #= (Y #[[rho]])"
using Op1 **
by (simp add: Y sameDom_def liftAll2_def)
(fastforce simp add: * lift_None lift_Some
liftAll_def lift_def split: option.splits)
qed
next
case (Op2 delta inp binp)
thus ?case
by (auto simp: sameDom_def liftAll2_def lift_None lift_def liftAll_def split: option.splits)
next
case (Abs1 xs x X)
show ?case proof safe
fix B
assume alpha_xXB: "qAbs xs x X $= B"
then obtain y Y where B: "B = qAbs xs y Y" unfolding qAbs_alphaAbs_iff by auto
have "qGoodAbs B" using ‹qGood X› alpha_xXB alphaAbs_preserves_qGoodAbs by force
hence goodY: "qGood Y" unfolding B by simp
let ?x' = "pickQFreshEnv xs {x} {X} {rho}"
let ?y' = "pickQFreshEnv xs {y} {Y} {rho}"
obtain x' and y' where x'y'_def: "x' = ?x'" "y' = ?y'" and
x'y'_rev: "?x' = x'" "?y' = y'" by blast
have x'y'_freshXY: "qFresh xs x' X ∧ qFresh xs y' Y"
unfolding x'y'_def using ‹qGood X› goodY goodRho by (auto simp add: pickQFreshEnv)
have x'y'_fresh_rho: "qFreshEnv xs x' rho ∧ qFreshEnv xs y' rho"
unfolding x'y'_def using ‹qGood X› goodY goodRho by (auto simp add: pickQFreshEnv)
have x'y'_not_xy: "x' ≠ x ∧ y' ≠ y"
unfolding x'y'_def using ‹qGood X› goodY goodRho
using pickQFreshEnv[of "{x}" "{X}"] pickQFreshEnv[of "{y}" "{Y}"] by force
have goodXx'x: "qGood (X #[[x' ∧ x]]_xs)" using ‹qGood X› qSwap_preserves_qGood by auto
hence good: "qGood(qPsubst rho (X #[[x' ∧ x]]_xs))"
using goodRho qPsubst_preserves_qGood by auto
have goodYy'y: "qGood (Y #[[y' ∧ y]]_xs)" using goodY qSwap_preserves_qGood by auto
obtain z where z_not: "z ∉ {x,y,x',y'}" and
z_fresh_XY: "qFresh xs z X ∧ qFresh xs z Y"
and z_fresh_rho: "qFreshEnv xs z rho" using ‹qGood X› goodY goodRho
using obtain_qFreshEnv[of "{x,y,x',y'}" "{X,Y}" "{rho}"] by auto
let ?Xx'x = "X #[[x' ∧ x]]_xs" let ?Yy'y = "Y #[[y' ∧ y]]_xs"
let ?Xx'xzx' = "?Xx'x #[[z ∧ x']]_xs" let ?Yy'yzy' = "?Yy'y #[[z ∧ y']]_xs"
let ?Xzx = "X #[[z ∧ x]]_xs" let ?Yzy = "Y #[[z ∧ y]]_xs"
have goodXx'x: "qGood ?Xx'x" using ‹qGood X› qSwap_preserves_qGood by auto
hence goodXx'xzx': "qGood ?Xx'xzx'" using qSwap_preserves_qGood by auto
have "qGood (?Xx'x #[[rho]])" using goodXx'x goodRho qPsubst_preserves_qGood by auto
hence goodXx'x_rho_zx': "qGood ((?Xx'x #[[rho]]) #[[z ∧ x']]_xs)"
using qSwap_preserves_qGood by auto
have goodYy'y: "qGood ?Yy'y" using goodY qSwap_preserves_qGood by auto
have skelXx'x: "qSkel ?Xx'x = qSkel X" using qSkel_qSwap by fastforce
hence skelXx'xzx': "qSkel ?Xx'xzx' = qSkel X" by (auto simp add: qSkel_qSwap)
have "qSkelAbs B = qSkelAbs (qAbs xs x X)"
using alpha_xXB alphaAll_qSkelAll by fastforce
hence "qSkel Y = qSkel X" unfolding B by(auto simp add: fun_eq_iff)
hence skelYy'y: "qSkel ?Yy'y = qSkel X" by(auto simp add: qSkel_qSwap)
have "((?Xx'x #[[rho]]) #[[z ∧ x']]_xs) #= (?Xx'xzx' #[[rho]])"
using skelXx'x goodXx'x z_fresh_rho x'y'_fresh_rho
Abs1.IH(2)[of "?Xx'x"] by (auto simp add: alpha_sym)
moreover
{have "?Xx'xzx' #= ?Xzx"
using ‹qGood X› x'y'_freshXY z_fresh_XY alpha_qFresh_qSwap_compose by fastforce
moreover have "?Xzx #= ?Yzy" using alpha_xXB unfolding B
using z_fresh_XY ‹qGood X› goodY
by (simp only: alphaAbs_qAbs_iff_all_qFresh)
moreover have "?Yzy #= ?Yy'yzy'" using goodY x'y'_freshXY z_fresh_XY
by(auto simp add: alpha_qFresh_qSwap_compose alpha_sym)
ultimately have "?Xx'xzx' #= ?Yy'yzy'" using goodXx'xzx' alpha_trans by blast
hence "(?Xx'xzx' #[[rho]]) #= (?Yy'yzy' #[[rho]])"
using goodXx'xzx' skelXx'xzx' Abs1.IH(1) by auto
}
moreover have "(?Yy'yzy' #[[rho]]) #= ((?Yy'y #[[rho]]) #[[z ∧ y']]_xs)"
using skelYy'y goodYy'y z_fresh_rho x'y'_fresh_rho
Abs1.IH(2)[of "?Yy'y"] alpha_sym by fastforce
ultimately
have "((?Xx'x #[[rho]]) #[[z ∧ x']]_xs) #= ((?Yy'y #[[rho]]) #[[z ∧ y']]_xs)"
using goodXx'x_rho_zx' alpha_trans by blast
thus "(qAbs xs x X) $[[rho]] $= (B $[[rho]])"
unfolding B apply simp unfolding Let_def
unfolding x'y'_rev
using good z_not apply(simp only: alphaAbs_qAbs_iff_ex_qFresh)
by (auto intro!: exI[of _ z]
simp: alphaAbs_qAbs_iff_ex_qFresh goodRho goodXx'x qPsubstAll_preserves_qFreshAll
qSwap_preserves_qFresh_distinct z_fresh_XY goodYy'y qPsubst_preserves_qFresh z_fresh_rho)
qed
next
case (Abs2 xs x X)
show ?case proof safe
fix zs z1 z2
assume z1z2_fresh_rho: "qFreshEnv zs z1 rho" "qFreshEnv zs z2 rho"
let ?x' = "pickQFreshEnv xs {x @xs[z1 ∧ z2]_zs} {X #[[z1 ∧ z2]]_zs} {rho}"
let ?x'' = "pickQFreshEnv xs {x} {X} {rho}"
obtain x' x'' where x'x''_def: "x' = ?x'" "x'' = ?x''" and
x'x''_rev: "?x' = x'" "?x'' = x''" by blast
let ?xa = "x @xs[z1 ∧ z2]_zs" let ?xa'' = "x'' @xs[z1 ∧ z2]_zs"
obtain u where "u ∉ {x,x',x'',z1,z2}" and
u_fresh_X: "qFresh xs u X" and u_fresh_rho: "qFreshEnv xs u rho"
using ‹qGood X› goodRho using obtain_qFreshEnv[of "{x,x',x'',z1,z2}" "{X}" "{rho}"] by auto
hence u_not: "u ∉ {x,x',x'',z1,z2,?xa,?xa''}" unfolding sw_def by auto
let ?ua = "u @xs [z1 ∧ z2]_zs"
let ?Xz1z2 = "X #[[z1 ∧ z2]]_zs"
let ?Xz1z2x'xa = "?Xz1z2 #[[x' ∧ ?xa]]_xs"
let ?Xz1z2x'xa_rho = "?Xz1z2x'xa #[[rho]]"
let ?Xz1z2x'xa_rho_ux' = "?Xz1z2x'xa_rho #[[u ∧ x']]_xs"
let ?Xz1z2x'xaux' = "?Xz1z2x'xa #[[u ∧ x']]_xs"
let ?Xz1z2x'xaux'_rho = "?Xz1z2x'xaux' #[[rho]]"
let ?Xz1z2uxa = "?Xz1z2 #[[u ∧ ?xa]]_xs"
let ?Xz1z2uaxa = "?Xz1z2 #[[?ua ∧ ?xa]]_xs"
let ?Xux = "X #[[u ∧ x]]_xs"
let ?Xuxz1z2 = "?Xux #[[z1 ∧ z2]]_zs"
let ?Xx''x = "X #[[x'' ∧ x]]_xs"
let ?Xx''xux'' = "?Xx''x #[[u ∧ x'']]_xs"
let ?Xx''xux''z1z2 = "?Xx''xux'' #[[z1 ∧ z2]]_zs"
let ?Xx''xz1z2 = "?Xx''x #[[z1 ∧ z2]]_zs"
let ?Xx''xz1z2uaxa'' = "?Xx''xz1z2 #[[?ua ∧ ?xa'']]_xs"
let ?Xx''xz1z2uaxa''_rho = "?Xx''xz1z2uaxa'' #[[rho]]"
let ?Xx''xz1z2uxa'' = "?Xx''xz1z2 #[[u ∧ ?xa'']]_xs"
let ?Xx''xz1z2uxa''_rho = "?Xx''xz1z2uxa'' #[[rho]]"
let ?Xx''xz1z2_rho = "?Xx''xz1z2 #[[rho]]"
let ?Xx''xz1z2_rho_uxa'' = "?Xx''xz1z2_rho #[[u ∧ ?xa'']]_xs"
let ?Xx''x_rho = "?Xx''x #[[rho]]"
let ?Xx''x_rho_z1z2 = "?Xx''x_rho #[[z1 ∧ z2]]_zs"
let ?Xx''x_rho_z1z2uxa'' = "?Xx''x_rho_z1z2 #[[u ∧ ?xa'']]_xs"
have goodXz1z2: "qGood ?Xz1z2" using ‹qGood X› qSwap_preserves_qGood by auto
have x'x''_fresh_Xz1z2: "qFresh xs x' ?Xz1z2 ∧ qFresh xs x'' X"
unfolding x'x''_def using ‹qGood X› goodXz1z2 goodRho by (auto simp add: pickQFreshEnv)
have x'x''_fresh_rho: "qFreshEnv xs x' rho ∧ qFreshEnv xs x'' rho"
unfolding x'x''_def using ‹qGood X› goodXz1z2 goodRho by (auto simp add: pickQFreshEnv)
have ua_eq_u: "?ua = u" using u_not unfolding sw_def by auto
have goodXz1z2x'xa: "qGood ?Xz1z2x'xa" using goodXz1z2 qSwap_preserves_qGood by auto
have goodXux: "qGood ?Xux" using ‹qGood X› qSwap_preserves_qGood by auto
hence goodXuxz1z2: "qGood ?Xuxz1z2" using qSwap_preserves_qGood by auto
have goodXx''x: "qGood ?Xx''x" using ‹qGood X› qSwap_preserves_qGood by auto
hence goodXx''xz1z2: "qGood ?Xx''xz1z2" using qSwap_preserves_qGood by auto
hence "qGood ?Xx''xz1z2_rho" using goodRho qPsubst_preserves_qGood by auto
hence goodXx''xz1z2_rho: "qGood ?Xx''xz1z2_rho"
using goodRho qPsubst_preserves_qGood by auto
have goodXz1z2x'xaux': "qGood ?Xz1z2x'xaux'"
using goodXz1z2x'xa qSwap_preserves_qGood by auto
have goodXz1z2x'xa_rho: "qGood ?Xz1z2x'xa_rho"
using goodXz1z2x'xa goodRho qPsubst_preserves_qGood by auto
hence goodXz1z2x'xa_rho_ux': "qGood ?Xz1z2x'xa_rho_ux'"
using qSwap_preserves_qGood by auto
have xa''_fresh_rho: "qFreshEnv xs ?xa'' rho"
using x'x''_fresh_rho z1z2_fresh_rho unfolding sw_def by auto
have u_fresh_Xz1z2: "qFresh xs u ?Xz1z2"
using u_fresh_X u_not by(auto simp add: qSwap_preserves_qFresh_distinct)
hence "qFresh xs u ?Xz1z2x'xa" using u_not by(auto simp add: qSwap_preserves_qFresh_distinct)
hence u_fresh_Xz1z2x'xa_rho: "qFresh xs u ?Xz1z2x'xa_rho"
using u_fresh_rho u_fresh_X goodRho goodXz1z2x'xa qPsubst_preserves_qFresh by auto
have "qFresh xs u ?Xx''x"
using u_fresh_X u_not by(auto simp add: qSwap_preserves_qFresh_distinct)
hence "qFresh xs u ?Xx''x_rho" using goodRho goodXx''x u_fresh_rho
by(auto simp add: qPsubst_preserves_qFresh)
hence u_fresh_Xx''x_rho_z1z2: "qFresh xs u ?Xx''x_rho_z1z2"
using u_not by(auto simp add: qSwap_preserves_qFresh_distinct)
have skel_Xz1z2x'xa: "qSkel ?Xz1z2x'xa = qSkel X" by(auto simp add: qSkel_qSwap)
hence skel_Xz1z2x'xaux': "qSkel ?Xz1z2x'xaux' = qSkel X" by(auto simp add: qSkel_qSwap)
have skel_Xx''x: "qSkel ?Xx''x = qSkel X" by(auto simp add: qSkel_qSwap)
hence skel_Xx''xz1z2: "qSkel ?Xx''xz1z2 = qSkel X" by(auto simp add: qSkel_qSwap)
have "?Xz1z2x'xaux'_rho #= ?Xz1z2x'xa_rho_ux'"
using x'x''_fresh_rho u_fresh_rho skel_Xz1z2x'xa goodXz1z2x'xa
using Abs2.IH(2)[of ?Xz1z2x'xa] by auto
hence "?Xz1z2x'xa_rho_ux' #= ?Xz1z2x'xaux'_rho" using alpha_sym by auto
moreover
{have "?Xz1z2x'xaux' #= ?Xz1z2uxa"
using goodXz1z2 u_fresh_Xz1z2 x'x''_fresh_Xz1z2
using alpha_qFresh_qSwap_compose by fastforce
moreover have "?Xz1z2uxa = ?Xuxz1z2"
using ua_eq_u qSwap_compose[of zs z1 z2 xs x u X] by(auto simp: qSwap_sym)
moreover
{have "?Xux #= ?Xx''xux''"
using ‹qGood X› u_fresh_X x'x''_fresh_Xz1z2
by(auto simp: alpha_qFresh_qSwap_compose alpha_sym)
hence "?Xuxz1z2 #= ?Xx''xux''z1z2"
using goodXux by (auto simp add: qSwap_preserves_alpha)
}
moreover have "?Xx''xux''z1z2 = ?Xx''xz1z2uxa''"
using ua_eq_u qSwap_compose[of zs z1 z2 _ _ _ ?Xx''x] by auto
ultimately have "?Xz1z2x'xaux' #= ?Xx''xz1z2uxa''"
using goodXz1z2x'xaux' alpha_trans by auto
hence "?Xz1z2x'xaux'_rho #= ?Xx''xz1z2uxa''_rho"
using goodXz1z2x'xaux' skel_Xz1z2x'xaux' Abs2.IH(1) by auto
}
moreover have "?Xx''xz1z2uxa''_rho #= ?Xx''xz1z2_rho_uxa''"
using xa''_fresh_rho u_fresh_rho skel_Xx''xz1z2 goodXx''xz1z2
using Abs2.IH(2)[of ?Xx''xz1z2] by auto
moreover
{have "?Xx''xz1z2_rho #= ?Xx''x_rho_z1z2"
using z1z2_fresh_rho skel_Xx''x goodXx''x
using Abs2.IH(2)[of ?Xx''x] by auto
hence "?Xx''xz1z2_rho_uxa'' #= ?Xx''x_rho_z1z2uxa''"
using goodXx''xz1z2_rho by(auto simp add: qSwap_preserves_alpha)
}
ultimately have "?Xz1z2x'xa_rho_ux' #= ?Xx''x_rho_z1z2uxa''"
using goodXz1z2x'xa_rho_ux' alpha_trans by blast
thus "((qAbs xs x X) $[[z1 ∧ z2]]_zs) $[[rho]] $=
(((qAbs xs x X) $[[rho]]) $[[z1 ∧ z2]]_zs)"
using goodXz1z2x'xa_rho
goodXz1z2x'xa u_not u_fresh_Xz1z2x'xa_rho u_fresh_Xx''x_rho_z1z2
apply(simp add: Let_def x'x''_rev del: alpha.simps alphaAbs.simps )
by (auto simp only: Let_def alphaAbs_qAbs_iff_ex_qFresh)
qed
qed
corollary qPsubst_preserves_alpha1:
assumes "qGoodEnv rho" and "qGood X ∨ qGood Y" and "X #= Y"
shows "(X #[[rho]]) #= (Y #[[rho]])"
using alpha_preserves_qGood assms qPsubstAll_preserves_alphaAll_qSwapAll by blast
corollary qPsubstAbs_preserves_alphaAbs1:
assumes "qGoodEnv rho" and "qGoodAbs A ∨ qGoodAbs B" and "A $= B"
shows "(A $[[rho]]) $= (B $[[rho]])"
using alphaAbs_preserves_qGoodAbs assms qPsubstAll_preserves_alphaAll_qSwapAll by blast
corollary alpha_qFreshEnv_qSwap_qPsubst_commute:
"⟦qGoodEnv rho; qGood X; qFreshEnv zs z1 rho; qFreshEnv zs z2 rho⟧ ⟹
((X #[[z1 ∧ z2]]_zs) #[[rho]]) #= ((X #[[rho]]) #[[z1 ∧ z2]]_zs)"
by(simp add: qPsubstAll_preserves_alphaAll_qSwapAll)
corollary alphaAbs_qFreshEnv_qSwapAbs_qPsubstAbs_commute:
"⟦qGoodEnv rho; qGoodAbs A;
qFreshEnv zs z1 rho; qFreshEnv zs z2 rho⟧ ⟹
((A $[[z1 ∧ z2]]_zs) $[[rho]]) $= ((A $[[rho]]) $[[z1 ∧ z2]]_zs)"
by(simp add: qPsubstAll_preserves_alphaAll_qSwapAll)
lemma qPsubstAll_preserves_alphaAll2:
fixes X::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
A::"('index,'bindex,'varSort,'var,'opSym)qAbs" and
rho'::"('index,'bindex,'varSort,'var,'opSym)qEnv" and rho''
assumes rho'_alpha_rho'': "rho' &= rho''" and
goodRho': "qGoodEnv rho'" and goodRho'': "qGoodEnv rho''"
shows
"(qGood X ⟶ (X #[[rho']]) #= (X #[[rho'']])) ∧
(qGoodAbs A ⟶ (A $[[rho']]) $= (A $[[rho'']]))"
proof(induction rule: qGood_qTerm_induct)
case (Var xs x)
then show ?case
proof (cases "rho' xs x")
case None
hence "rho'' xs x = None" using rho'_alpha_rho'' unfolding alphaEnv_def sameDom_def by auto
thus ?thesis using None by simp
next
case (Some X')
then obtain X'' where rho'': "rho'' xs x = Some X''"
using assms unfolding alphaEnv_def sameDom_def by force
hence "X' #= X''" using Some rho'_alpha_rho''
unfolding alphaEnv_def liftAll2_def by auto
thus ?thesis using Some rho'' by simp
qed
next
case (Op delta inp binp)
then show ?case
by (auto simp: lift_def liftAll_def liftAll2_def sameDom_def Let_def
split: option.splits)
next
case (Abs xs x X)
let ?x' = "pickQFreshEnv xs {x} {X} {rho'}"
let ?x'' = "pickQFreshEnv xs {x} {X} {rho''}"
obtain x' x'' where x'x''_def: "x' = ?x'" "x'' = ?x''" and
x'x''_rev: "?x' = x'" "?x'' = x''" by blast
have x'x''_fresh_X: "qFresh xs x' X ∧ qFresh xs x'' X"
unfolding x'x''_def using ‹qGood X› goodRho' goodRho'' by (auto simp add: pickQFreshEnv)
have x'_fresh_rho': "qFreshEnv xs x' rho'"
unfolding x'x''_def using ‹qGood X› goodRho' goodRho'' by (auto simp add: pickQFreshEnv)
have x''_fresh_rho'': "qFreshEnv xs x'' rho''"
unfolding x'x''_def using ‹qGood X› goodRho' goodRho'' by (auto simp add: pickQFreshEnv)
obtain u where u_not: "u ∉ {x,x',x''}" and
u_fresh_X: "qFresh xs u X" and
u_fresh_rho': "qFreshEnv xs u rho'" and u_fresh_rho'': "qFreshEnv xs u rho''"
using ‹qGood X› goodRho' goodRho''
using obtain_qFreshEnv[of "{x,x',x''}" "{X}" "{rho',rho''}"] by auto
let ?Xx'x = "X #[[x' ∧ x]]_xs"
let ?Xx'x_rho' = "?Xx'x #[[rho']]"
let ?Xx'x_rho'_ux' = "?Xx'x_rho' #[[u ∧ x']]_xs"
let ?Xx'xux' = "?Xx'x #[[u ∧ x']]_xs"
let ?Xx'xux'_rho' = "?Xx'xux' #[[rho']]"
let ?Xux = "X #[[u ∧ x]]_xs"
let ?Xux_rho' = "?Xux #[[rho']]"
let ?Xux_rho'' = "?Xux #[[rho'']]"
let ?Xx''x = "X #[[x'' ∧ x]]_xs"
let ?Xx''xux'' = "?Xx''x #[[u ∧ x'']]_xs"
let ?Xx''xux''_rho'' = "?Xx''xux'' #[[rho'']]"
let ?Xx''x_rho'' = "?Xx''x #[[rho'']]"
let ?Xx''x_rho''_ux'' = "?Xx''x_rho'' #[[u ∧ x'']]_xs"
have goodXx'x: "qGood ?Xx'x" using ‹qGood X› qSwap_preserves_qGood by auto
hence goodXx'x_rho': "qGood ?Xx'x_rho'" using ‹qGood X› goodRho' qPsubst_preserves_qGood by auto
hence goodXx'x_rho'_ux': "qGood ?Xx'x_rho'_ux'"
using ‹qGood X› qSwap_preserves_qGood by auto
have goodXx'xux': "qGood ?Xx'xux'" using goodXx'x qSwap_preserves_qGood by auto
have goodXux: "qGood ?Xux" using ‹qGood X› qSwap_preserves_qGood by auto
have goodXx''x: "qGood ?Xx''x" using ‹qGood X› qSwap_preserves_qGood by auto
hence goodXx''x_rho'': "qGood ?Xx''x_rho''"
using ‹qGood X› goodRho'' qPsubst_preserves_qGood by auto
have "qFresh xs u ?Xx'x" using u_not u_fresh_X
by(auto simp add: qSwap_preserves_qFresh_distinct)
hence fresh_Xx'x_rho': "qFresh xs u ?Xx'x_rho'"
using u_fresh_rho' goodXx'x goodRho' by(auto simp add: qPsubst_preserves_qFresh)
have "qFresh xs u ?Xx''x" using u_not u_fresh_X
by(auto simp add: qSwap_preserves_qFresh_distinct)
hence fresh_Xx''x_rho'': "qFresh xs u ?Xx''x_rho''"
using u_fresh_rho'' goodXx''x goodRho'' by(auto simp add: qPsubst_preserves_qFresh)
have Xux: "(X,?Xux) :qSwapped" by(simp add: qSwap_qSwapped)
have "?Xx'x_rho'_ux' #= ?Xx'xux'_rho'"
using goodRho' goodXx'x u_fresh_rho' x'_fresh_rho'
by(auto simp: alpha_qFreshEnv_qSwap_qPsubst_commute alpha_sym)
moreover
{have "?Xx'xux' #= ?Xux" using ‹qGood X› u_fresh_X x'x''_fresh_X
using alpha_qFresh_qSwap_compose by fastforce
hence "?Xx'xux'_rho' #= ?Xux_rho'" using goodXx'xux' goodRho'
using qPsubst_preserves_alpha1 by auto
}
moreover have "?Xux_rho' #= ?Xux_rho''" using Xux Abs.IH by auto
moreover
{have "?Xux #= ?Xx''xux''" using ‹qGood X› u_fresh_X x'x''_fresh_X
by(auto simp add: alpha_qFresh_qSwap_compose alpha_sym)
hence "?Xux_rho'' #= ?Xx''xux''_rho''" using goodXux goodRho''
using qPsubst_preserves_alpha1 by auto
}
moreover have "?Xx''xux''_rho'' #= ?Xx''x_rho''_ux''"
using goodRho'' goodXx''x u_fresh_rho'' x''_fresh_rho''
by(auto simp: alpha_qFreshEnv_qSwap_qPsubst_commute)
ultimately have "?Xx'x_rho'_ux' #= ?Xx''x_rho''_ux''"
using goodXx'x_rho'_ux' alpha_trans by blast
hence "qAbs xs ?x' (qPsubst rho' (X #[[?x' ∧ x]]_xs)) $=
qAbs xs ?x''(qPsubst rho''(X #[[?x''∧ x]]_xs))"
unfolding x'x''_rev using goodXx'x_rho' fresh_Xx'x_rho' fresh_Xx''x_rho''
by (auto simp only: alphaAbs_qAbs_iff_ex_qFresh)
thus ?case by (metis qPsubstAbs.simps)
qed
corollary qPsubst_preserves_alpha2:
"⟦qGood X; qGoodEnv rho'; qGoodEnv rho''; rho' &= rho''⟧
⟹ (X #[[rho']]) #= (X #[[rho'']])"
by(simp add: qPsubstAll_preserves_alphaAll2)
corollary qPsubstAbs_preserves_alphaAbs2:
"⟦qGoodAbs A; qGoodEnv rho'; qGoodEnv rho''; rho' &= rho''⟧
⟹ (A $[[rho']]) $= (A $[[rho'']])"
by(simp add: qPsubstAll_preserves_alphaAll2)
lemma qPsubst_preserves_alpha:
assumes "qGood X ∨ qGood X'" and "qGoodEnv rho" and "qGoodEnv rho'"
and "X #= X'" and "rho &= rho'"
shows "(X #[[rho]]) #= (X' #[[rho']])"
by (metis (no_types, lifting) assms alpha_trans qPsubst_preserves_alpha1
qPsubst_preserves_alpha2 qPsubst_preserves_qGood)
lemma qPsubstAbs_preserves_alphaAbs:
assumes "qGoodAbs A ∨ qGoodAbs A'" and "qGoodEnv rho" and "qGoodEnv rho'"
and "A $= A'" and "rho &= rho'"
shows "(A $[[rho]]) $= (A' $[[rho']])"
using assms
by (meson alphaAbs_trans qPsubstAbs_preserves_alphaAbs1
qPsubstAbs_preserves_qGoodAbs qPsubstAll_preserves_alphaAll2)
lemma qFresh_qPsubst_commute_qAbs:
assumes good_X: "qGood X" and good_rho: "qGoodEnv rho" and
x_fresh_rho: "qFreshEnv xs x rho"
shows "((qAbs xs x X) $[[rho]]) $= qAbs xs x (X #[[rho]])"
proof-
let ?x' = "pickQFreshEnv xs {x} {X} {rho}"
obtain x' where x'_def: "x' = ?x'" and x'_rev: "?x' = x'" by blast
have x'_not: "x' ≠ x" unfolding x'_def
using assms pickQFreshEnv[of "{x}" "{X}"] by auto
have x'_fresh_X: "qFresh xs x' X" unfolding x'_def
using assms pickQFreshEnv[of "{x}" "{X}"] by auto
have x'_fresh_rho: "qFreshEnv xs x' rho" unfolding x'_def
using assms pickQFreshEnv[of "{x}" "{X}"] by auto
obtain u where u_not: "u ∉ {x,x'}" and
u_fresh_X: "qFresh xs u X" and u_fresh_rho: "qFreshEnv xs u rho"
using good_X good_rho obtain_qFreshEnv[of "{x,x'}" "{X}" "{rho}"] by auto
let ?Xx'x = "X #[[x' ∧ x]]_xs"
let ?Xx'x_rho = "?Xx'x #[[rho]]"
let ?Xx'x_rho_ux' = "?Xx'x_rho #[[u ∧ x']]_xs"
let ?Xx'xux' = "?Xx'x #[[u ∧ x']]_xs"
let ?Xx'xux'_rho = "?Xx'xux' #[[rho]]"
let ?Xux = "X #[[u ∧ x]]_xs"
let ?Xux_rho = "?Xux #[[rho]]"
let ?Xrho = "X #[[rho]]"
let ?Xrho_ux = "?Xrho #[[u ∧ x]]_xs"
have good_Xx'x: "qGood ?Xx'x" using good_X qSwap_preserves_qGood by auto
hence good_Xx'x_rho: "qGood ?Xx'x_rho" using good_rho qPsubst_preserves_qGood by auto
hence good_Xx'x_rho_ux': "qGood ?Xx'x_rho_ux'" using qSwap_preserves_qGood by auto
have good_Xx'xux': "qGood ?Xx'xux'" using good_Xx'x qSwap_preserves_qGood by auto
have u_fresh_Xx'x: "qFresh xs u ?Xx'x"
using u_fresh_X u_not by(auto simp add: qSwap_preserves_qFresh_distinct)
hence u_fresh_Xx'x_rho: "qFresh xs u ?Xx'x_rho"
using good_rho good_Xx'x u_fresh_rho by(auto simp add: qPsubst_preserves_qFresh)
have u_fresh_Xrho: "qFresh xs u ?Xrho"
using good_rho good_X u_fresh_X u_fresh_rho by(auto simp add: qPsubst_preserves_qFresh)
-
have "?Xx'x_rho_ux' #= ?Xx'xux'_rho"
using good_Xx'x good_rho u_fresh_rho x'_fresh_rho
using alpha_qFreshEnv_qSwap_qPsubst_commute alpha_sym by blast
moreover
{have "?Xx'xux' #= ?Xux"
using good_X u_fresh_X x'_fresh_X by (auto simp add: alpha_qFresh_qSwap_compose)
hence "?Xx'xux'_rho #= ?Xux_rho"
using good_Xx'xux' good_rho qPsubst_preserves_alpha1 by auto
}
moreover have "?Xux_rho #= ?Xrho_ux"
using good_X good_rho u_fresh_rho x_fresh_rho
using alpha_qFreshEnv_qSwap_qPsubst_commute by blast
ultimately have "?Xx'x_rho_ux' #= ?Xrho_ux"
using good_Xx'x_rho_ux' alpha_trans by blast
thus ?thesis apply (simp add: Let_def del: alpha.simps alphaAbs.simps)
unfolding x'_rev using good_Xx'x_rho
using u_fresh_Xx'x_rho u_fresh_Xrho by (auto simp only: alphaAbs_qAbs_iff_ex_qFresh)
qed
end
end
Theory Pick
theory Pick imports Main
begin
definition "pick X ≡ SOME x. x ∈ X"
lemma pick[simp]: "x ∈ X ⟹ pick X ∈ X"
unfolding pick_def by (metis someI_ex)
lemma pick_NE[simp]: "X ≠ {} ⟹ pick X ∈ X" by auto
endTheory Equiv_Relation2
section ‹Some preliminaries on equivalence relations and quotients›
theory Equiv_Relation2 imports Preliminaries Pick
begin
text‹Unary predicates vs. sets:›
definition "S2P A ≡ λ x. x ∈ A"
lemma S2P_app[simp]: "S2P r x ⟷ x ∈ r"
unfolding S2P_def by auto
lemma S2P_Collect[simp]: "S2P (Collect φ) = φ"
apply(rule ext)+ by simp
lemma Collect_S2P[simp]: "Collect (S2P r) = r"
by (metis Collect_mem_eq S2P_Collect)
text‹Binary predicates vs. relatipons:›
definition "P2R φ ≡ {(x,y). φ x y}"
definition "R2P r ≡ λ x y. (x,y) ∈ r"
lemma in_P2R[simp]: "xy ∈ P2R φ ⟷ φ (fst xy) (snd xy)"
unfolding P2R_def by auto
lemma in_P2R_pair[simp]: "(x,y) ∈ P2R φ ⟷ φ x y"
by simp
lemma R2P_app[simp]: "R2P r x y ⟷ (x,y) ∈ r"
unfolding R2P_def by auto
lemma R2P_P2R[simp]: "R2P (P2R φ) = φ"
apply(rule ext)+ by simp
lemma P2R_R2P[simp]: "P2R (R2P r) = r"
using Collect_mem_eq P2R_def R2P_P2R case_prod_curry by metis
definition "reflP P φ ≡ (∀ x y. φ x y ∨ φ y x ⟶ P x) ∧ (∀ x. P x ⟶ φ x x)"
definition "symP φ ≡ ∀ x y. φ x y ⟶ φ y x"
definition transP where "transP φ ≡ ∀ x y z. φ x y ∧ φ y z ⟶ φ x z"
definition "equivP A φ ≡ reflP A φ ∧ symP φ ∧ transP φ"
lemma refl_on_P2R[simp]: "refl_on (Collect P) (P2R φ) ⟷ reflP P φ"
unfolding reflP_def refl_on_def by force
lemma reflP_R2P[simp]: "reflP (S2P A) (R2P r) ⟷ refl_on A r"
unfolding reflP_def refl_on_def by auto
lemma sym_P2R[simp]: "sym (P2R φ) ⟷ symP φ"
unfolding symP_def sym_def by auto
lemma symP_R2P[simp]: "symP (R2P r) ⟷ sym r"
unfolding symP_def sym_def by auto
lemma trans_P2R[simp]: "trans (P2R φ) ⟷ transP φ"
unfolding transP_def trans_def by auto
lemma transP_R2P[simp]: "transP (R2P r) ⟷ trans r"
unfolding transP_def trans_def by auto
lemma equiv_P2R[simp]: "equiv (Collect P) (P2R φ) ⟷ equivP P φ"
unfolding equivP_def equiv_def by auto
lemma equivP_R2P[simp]: "equivP (S2P A) (R2P r) ⟷ equiv A r"
unfolding equivP_def equiv_def by auto
lemma in_P2R_Im_singl[simp]: "y ∈ P2R φ `` {x} ⟷ φ x y" by simp
definition proj :: "('a ⇒ 'a ⇒ bool) ⇒ 'a ⇒ 'a set" where
"proj φ x ≡ {y. φ x y}"
lemma proj_P2R: "proj φ x = P2R φ `` {x}" unfolding proj_def by auto
lemma proj_P2R_raw: "proj φ = (λ x. P2R φ `` {x})"
apply(rule ext) unfolding proj_P2R ..
definition univ :: "('a ⇒ 'b) ⇒ ('a set ⇒ 'b)"
where "univ f X == f (SOME x. x ∈ X)"
definition quotientP ::
"('a ⇒ bool) ⇒ ('a ⇒ 'a ⇒ bool) ⇒ ('a set ⇒ bool)" (infixl "'/'/'/" 90)
where "P /// φ ≡ S2P ((Collect P) // (P2R φ))"
lemma proj_preserves:
"P x ⟹ (P /// φ) (proj φ x)"
unfolding proj_P2R quotientP_def
by (metis S2P_def mem_Collect_eq quotientI)
lemma proj_in_iff:
assumes "equivP P φ"
shows "(P///φ) (proj φ x) ⟷ P x"
using assms unfolding quotientP_def proj_def
by (metis (mono_tags) Collect_mem_eq Equiv_Relation2.proj_def
Equiv_Relation2.proj_preserves S2P_Collect empty_Collect_eq equivP_def
equiv_P2R in_quotient_imp_non_empty quotientP_def reflP_def)
lemma proj_iff[simp]:
"⟦equivP P φ; P x; P y⟧ ⟹ proj φ x = proj φ y ⟷ φ x y"
unfolding proj_P2R
by (metis (full_types) equiv_P2R equiv_class_eq_iff equiv_class_self
in_P2R_pair mem_Collect_eq proj_P2R proj_def)
lemma in_proj[simp]: "⟦equivP P φ; P x⟧ ⟹ x ∈ proj φ x"
unfolding proj_P2R equiv_def refl_on_def equiv_P2R[symmetric]
by auto
lemma proj_image[simp]: "(proj φ) ` (Collect P) = Collect (P///φ)"
unfolding proj_P2R_raw quotientP_def quotient_def by auto
lemma in_quotientP_imp_non_empty:
assumes "equivP P φ" and "(P///φ) X"
shows "X ≠ {}"
by (metis R2P_P2R S2P_Collect S2P_def assms equivP_R2P
in_quotient_imp_non_empty quotientP_def)
lemma in_quotientP_imp_in_rel:
"⟦equivP P φ; (P///φ) X; x ∈ X; y ∈ X⟧ ⟹ φ x y"
unfolding equiv_P2R[symmetric] quotientP_def quotient_eq_iff
by (metis S2P_def in_P2R_pair quotient_eq_iff)
lemma in_quotientP_imp_closed:
"⟦equivP P φ; (P///φ) X; x ∈ X; φ x y⟧ ⟹ y ∈ X"
using S2P_Collect S2P_def equivP_def proj_P2R_raw proj_def
quotientE quotientP_def transP_def
by metis
lemma in_quotientP_imp_subset:
assumes "equivP P φ" and "(P///φ) X"
shows "X ⊆ Collect P"
by (metis (mono_tags, lifting) CollectI assms equivP_def in_quotientP_imp_in_rel reflP_def subsetI)
lemma equivP_pick_in:
assumes "equivP P φ " and "(P///φ) X"
shows "pick X ∈ X"
by (metis assms in_quotientP_imp_non_empty pick_NE)
lemma equivP_pick_preserves:
assumes "equivP P φ " and "(P///φ) X"
shows "P (pick X)"
by (metis assms equivP_pick_in in_quotientP_imp_subset mem_Collect_eq set_rev_mp)
lemma proj_pick:
assumes φ: "equivP P φ" and X: "(P///φ) X"
shows "proj φ (pick X) = X"
by (smt proj_def Equiv_Relation2.proj_iff Equiv_Relation2.proj_image X
φ equivP_pick_in equivP_pick_preserves image_iff mem_Collect_eq)
lemma pick_proj:
assumes "equivP P φ" and "P x"
shows "φ (pick (proj φ x)) x"
by (metis assms equivP_def in_proj mem_Collect_eq pick proj_def symP_def)
lemma equivP_pick_iff[simp]:
assumes φ: "equivP P φ" and X: "(P///φ) X" and Y: "(P///φ) Y"
shows "φ (pick X) (pick Y) ⟷ X = Y"
by (metis Equiv_Relation2.proj_iff X Y φ equivP_pick_preserves proj_pick)
lemma equivP_pick_inj_on:
assumes "equivP P φ"
shows "inj_on pick (Collect (P///φ))"
using assms unfolding inj_on_def
by (metis assms equivP_pick_iff mem_Collect_eq)
definition congruentP where
"congruentP φ f ≡ ∀ x y. φ x y ⟶ f x = f y"
abbreviation RESPECTS_P (infixr "respectsP" 80) where
"f respectsP r == congruentP r f"
lemma congruent_P2R: "congruent (P2R φ) f = congruentP φ f"
unfolding congruent_def congruentP_def by auto
lemma univ_commute[simp]:
assumes "equivP P φ" and "f respectsP φ" and "P x"
shows "(univ f) (proj φ x) = f x"
unfolding congruent_P2R[symmetric]
by (metis (full_types) assms pick_def congruentP_def pick_proj univ_def)
lemma univ_unique:
assumes "equivP P φ" and "f respectsP φ" and "⋀ x. P x ⟹ G (proj φ x) = f x"
shows "∀ X. (P///φ) X ⟶ G X = univ f X"
by (metis assms equivP_pick_preserves proj_pick univ_commute)
lemma univ_preserves:
assumes "equivP P φ " and "f respectsP φ" and "⋀ x. P x ⟹ f x ∈ B"
shows "∀ X. (P///φ) X ⟶ univ f X ∈ B"
by (metis Equiv_Relation2.univ_commute assms
equivP_pick_preserves proj_pick)
end
Theory Transition_QuasiTerms_Terms
section ‹Transition from Quasi-Terms to Terms›
theory Transition_QuasiTerms_Terms
imports QuasiTerms_Environments_Substitution Equiv_Relation2
begin
text‹This section transits from quasi-terms to terms: defines terms as alpha-equivalence
classes of quasi-terms
(and also abstractions as alpha-equivalence classes of quasi-abstractions),
then defines operators on terms corresponding to those on quasi-terms:
variable injection, binding operation, freshness, swapping, parallel substitution, etc.
Properties previously shown invariant
under alpha-equivalence, including induction principles, are lifted from quasi-terms.
Moreover, a new powerful induction principle, allowing freshness assumptions,
is proved for terms.
As a matter of notation:
Starting from this section, we change the notations for quasi-item meta-variables, prefixing
their names with a "q" -- e.g., qX, qA, qinp, qenv, etc. The old names are now assigned
to the ``real" items: terms, abstractions, inputs, environments.›
subsection ‹Preparation: Integrating quasi-inputs as first-class citizens›
context FixVars
begin
text‹From now on it will be convenient to
also define fresh, swap, good and alpha-equivalence for quasi-inpus.›
definition qSwapInp where
"qSwapInp xs x y qinp == lift (qSwap xs x y) qinp"
definition qSwapBinp where
"qSwapBinp xs x y qbinp == lift (qSwapAbs xs x y) qbinp"
abbreviation qSwapInp_abbrev ("_ %[[_ ∧ _]]'__" 200) where
"(qinp %[[z1 ∧ z2]]_zs) == qSwapInp zs z1 z2 qinp"
abbreviation qSwapBinp_abbrev ("_ %%[[_ ∧ _]]'__" 200) where
"(qbinp %%[[z1 ∧ z2]]_zs) == qSwapBinp zs z1 z2 qbinp"
lemma qSwap_qSwapInp:
"((qOp delta qinp qbinp) #[[x ∧ y]]_xs) =
qOp delta (qinp %[[x ∧ y]]_xs) (qbinp %%[[x ∧ y]]_xs)"
unfolding qSwapInp_def qSwapBinp_def by simp
declare qSwap.simps(2) [simp del]
declare qSwap_qSwapInp[simp]
lemmas qSwapAll_simps = qSwap.simps(1) qSwap_qSwapInp
definition qPsubstInp where
"qPsubstInp qrho qinp == lift (qPsubst qrho) qinp"
definition qPsubstBinp where
"qPsubstBinp qrho qbinp == lift (qPsubstAbs qrho) qbinp"
abbreviation qPsubstInp_abbrev ("_ %[[_]]" 200)
where "(qinp %[[qrho]]) == qPsubstInp qrho qinp"
abbreviation qPsubstBinp_abbrev ("_ %%[[_]]" 200)
where "(qbinp %%[[qrho]]) == qPsubstBinp qrho qbinp"
lemma qPsubst_qPsubstInp:
"((qOp delta qinp qbinp) #[[rho]]) = qOp delta (qinp %[[rho]]) (qbinp %%[[rho]])"
unfolding qPsubstInp_def qPsubstBinp_def by simp
declare qPsubst.simps(2) [simp del]
declare qPsubst_qPsubstInp[simp]
lemmas qPsubstAll_simps = qPsubst.simps(1) qPsubst_qPsubstInp
definition qSkelInp
where "qSkelInp qinp = lift qSkel qinp"
definition qSkelBinp
where "qSkelBinp qbinp = lift qSkelAbs qbinp"
lemma qSkel_qSkelInp:
"qSkel (qOp delta qinp qbinp) =
Branch (qSkelInp qinp) (qSkelBinp qbinp)"
unfolding qSkelInp_def qSkelBinp_def by simp
declare qSkel.simps(2) [simp del]
declare qSkel_qSkelInp[simp]
lemmas qSkelAll_simps = qSkel.simps(1) qSkel_qSkelInp
definition qFreshInp ::
"'varSort ⇒ 'var ⇒ ('index,('index,'bindex,'varSort,'var,'opSym)qTerm)input ⇒ bool"
where
"qFreshInp xs x qinp == liftAll (qFresh xs x) qinp"
definition qFreshBinp ::
"'varSort ⇒ 'var ⇒ ('bindex,('index,'bindex,'varSort,'var,'opSym)qAbs)input ⇒ bool"
where
"qFreshBinp xs x qbinp == liftAll (qFreshAbs xs x) qbinp"
lemma qFresh_qFreshInp:
"qFresh xs x (qOp delta qinp qbinp) =
(qFreshInp xs x qinp ∧ qFreshBinp xs x qbinp)"
unfolding qFreshInp_def qFreshBinp_def by simp
declare qFresh.simps(2) [simp del]
declare qFresh_qFreshInp[simp]
lemmas qFreshAll_simps = qFresh.simps(1) qFresh_qFreshInp
definition qGoodInp where
"qGoodInp qinp ==
liftAll qGood qinp ∧
|{i. qinp i ≠ None}| <o |UNIV :: 'var set|"
definition qGoodBinp where
"qGoodBinp qbinp ==
liftAll qGoodAbs qbinp ∧
|{i. qbinp i ≠ None}| <o |UNIV :: 'var set|"
lemma qGood_qGoodInp:
"qGood (qOp delta qinp qbinp) = (qGoodInp qinp ∧ qGoodBinp qbinp)"
unfolding qGoodInp_def qGoodBinp_def by auto
declare qGood.simps(2) [simp del]
declare qGood_qGoodInp [simp]
lemmas qGoodAll_simps = qGood.simps(1) qGood_qGoodInp
definition alphaInp where
"alphaInp ==
{(qinp,qinp'). sameDom qinp qinp' ∧ liftAll2 (λqX qX'. qX #= qX') qinp qinp'}"
definition alphaBinp where
"alphaBinp ==
{(qbinp,qbinp'). sameDom qbinp qbinp' ∧ liftAll2 (λqA qA'. qA $= qA') qbinp qbinp'}"
abbreviation alphaInp_abbrev (infix "%=" 50) where
"qinp %= qinp' == (qinp,qinp') ∈ alphaInp"
abbreviation alphaBinp_abbrev (infix "%%=" 50) where
"qbinp %%= qbinp' == (qbinp,qbinp') ∈ alphaBinp"
lemma alpha_alphaInp:
"(qOp delta qinp qbinp #= qOp delta' qinp' qbinp') =
(delta = delta' ∧ qinp %= qinp' ∧ qbinp %%= qbinp')"
unfolding alphaInp_def alphaBinp_def by auto
declare alpha.simps(2) [simp del]
declare alpha_alphaInp[simp]
lemmas alphaAll_Simps =
alpha.simps(1) alpha_alphaInp
alphaAbs.simps
lemma alphaInp_refl:
"qGoodInp qinp ⟹ qinp %= qinp"
using alpha_refl
unfolding alphaInp_def qGoodInp_def liftAll_def liftAll2_def sameDom_def
by fastforce
lemma alphaBinp_refl:
"qGoodBinp qbinp ⟹ qbinp %%= qbinp"
using alphaAbs_refl
unfolding alphaBinp_def qGoodBinp_def liftAll_def liftAll2_def sameDom_def
by fastforce
lemma alphaInp_sym:
fixes qinp qinp' :: "('index,('index,'bindex,'varSort,'var,'opSym)qTerm)input"
shows "qinp %= qinp' ⟹ qinp' %= qinp"
using alpha_sym unfolding alphaInp_def sameDom_def liftAll2_def by blast
lemma alphaBinp_sym:
fixes qbinp qbinp' :: "('bindex,('index,'bindex,'varSort,'var,'opSym)qAbs)input"
shows "qbinp %%= qbinp' ⟹ qbinp' %%= qbinp"
using alphaAbs_sym unfolding alphaBinp_def sameDom_def liftAll2_def by blast
lemma alphaInp_trans:
assumes good: "qGoodInp qinp" and
alpha1: "qinp %= qinp'" and alpha2: "qinp' %= qinp''"
shows "qinp %= qinp''"
proof-
{fix i qX qX'' assume qinp: "qinp i = Some qX" and qinp'': "qinp'' i = Some qX''"
then obtain qX' where qinp': "qinp' i = Some qX'"
using alpha1 unfolding alphaInp_def sameDom_def liftAll2_def by(cases "qinp' i", force)
hence "qX #= qX'"
using alpha1 qinp unfolding alphaInp_def sameDom_def liftAll2_def by auto
moreover have "qX' #= qX''" using alpha2 qinp' qinp''
unfolding alphaInp_def sameDom_def liftAll2_def by auto
moreover have "qGood qX" using good qinp unfolding qGoodInp_def liftAll_def by auto
ultimately have "qX #= qX''" using alpha_trans by blast
}
thus ?thesis using assms unfolding alphaInp_def sameDom_def liftAll2_def by auto
qed
lemma alphaBinp_trans:
assumes good: "qGoodBinp qbinp" and
alpha1: "qbinp %%= qbinp'" and alpha2: "qbinp' %%= qbinp''"
shows "qbinp %%= qbinp''"
proof-
{fix i qA qA'' assume qbinp: "qbinp i = Some qA" and qbinp'': "qbinp'' i = Some qA''"
then obtain qA' where qbinp': "qbinp' i = Some qA'"
using alpha1 unfolding alphaBinp_def sameDom_def liftAll2_def by(cases "qbinp' i", force)
hence "qA $= qA'"
using alpha1 qbinp unfolding alphaBinp_def sameDom_def liftAll2_def by auto
moreover have "qA' $= qA''" using alpha2 qbinp' qbinp''
unfolding alphaBinp_def sameDom_def liftAll2_def by auto
moreover have "qGoodAbs qA" using good qbinp unfolding qGoodBinp_def liftAll_def by auto
ultimately have "qA $= qA''" using alphaAbs_trans by blast
}
thus ?thesis using assms unfolding alphaBinp_def sameDom_def liftAll2_def by auto
qed
lemma qSwapInp_preserves_qGoodInp:
assumes "qGoodInp qinp"
shows "qGoodInp (qinp %[[x1 ∧ x2]]_xs)"
proof-
{let ?qinp' = "lift (qSwap xs x1 x2) qinp"
fix xsa let ?Left = "{i. ?qinp' i ≠ None}"
have "?Left = {i. qinp i ≠ None}" by(auto simp add: lift_None)
hence "|?Left| <o |UNIV :: 'var set|" using assms unfolding qGoodInp_def by auto
}
thus ?thesis using assms
unfolding qGoodInp_def qSwapInp_def liftAll_lift_comp qGoodInp_def
unfolding comp_def liftAll_def
by (auto simp add: qSwap_preserves_qGood simp del: not_None_eq)
qed
lemma qSwapBinp_preserves_qGoodBinp:
assumes "qGoodBinp qbinp"
shows "qGoodBinp (qbinp %%[[x1 ∧ x2]]_xs)"
proof-
{let ?qbinp' = "lift (qSwapAbs xs x1 x2) qbinp"
fix xsa let ?Left = "{i. ?qbinp' i ≠ None}"
have "?Left = {i. qbinp i ≠ None}" by(auto simp add: lift_None)
hence "|?Left| <o |UNIV :: 'var set|" using assms unfolding qGoodBinp_def by auto
}
thus ?thesis using assms
unfolding qGoodBinp_def qSwapBinp_def liftAll_lift_comp
unfolding qGoodBinp_def unfolding comp_def liftAll_def
by (auto simp add: qSwapAbs_preserves_qGoodAbs simp del: not_None_eq)
qed
lemma qSwapInp_preserves_alphaInp:
assumes "qGoodInp qinp ∨ qGoodInp qinp'" and "qinp %= qinp'"
shows "(qinp %[[x1 ∧ x2]]_xs) %= (qinp' %[[x1 ∧ x2]]_xs)"
using assms unfolding alphaInp_def qSwapInp_def sameDom_def liftAll2_def
by (simp add: lift_None)
(smt liftAll_def lift_def option.case_eq_if option.exhaust_sel
option.sel qGoodInp_def qSwap_preserves_alpha)
lemma qSwapBinp_preserves_alphaBinp:
assumes "qGoodBinp qbinp ∨ qGoodBinp qbinp'" and "qbinp %%= qbinp'"
shows "(qbinp %%[[x1 ∧ x2]]_xs) %%= (qbinp' %%[[x1 ∧ x2]]_xs)"
using assms unfolding alphaBinp_def qSwapBinp_def sameDom_def liftAll2_def
by (simp add: lift_None)
(smt liftAll_def lift_def option.case_eq_if option.exhaust_sel option.sel
qGoodBinp_def qSwapAbs_preserves_alphaAbs)
lemma qPsubstInp_preserves_qGoodInp:
assumes "qGoodInp qinp" and "qGoodEnv qrho"
shows "qGoodInp (qinp %[[qrho]])"
using assms unfolding qGoodInp_def qPsubstInp_def liftAll_def
by simp (smt Collect_cong lift_def option.case_eq_if
option.exhaust_sel option.sel qPsubst_preserves_qGood)
lemma qPsubstBinp_preserves_qGoodBinp:
assumes "qGoodBinp qbinp" and "qGoodEnv qrho"
shows "qGoodBinp (qbinp %%[[qrho]])"
using assms unfolding qGoodBinp_def qPsubstBinp_def liftAll_def
by simp (smt Collect_cong lift_def option.case_eq_if
option.exhaust_sel option.sel qPsubstAbs_preserves_qGoodAbs)
lemma qPsubstInp_preserves_alphaInp:
assumes "qGoodInp qinp ∨ qGoodInp qinp'" and "qGoodEnv qrho" and "qinp %= qinp'"
shows "(qinp %[[qrho]]) %= (qinp' %[[qrho]])"
using assms unfolding alphaInp_def qPsubstInp_def sameDom_def liftAll2_def
by (simp add: lift_None)
(smt liftAll_def lift_def option.case_eq_if option.exhaust_sel
option.sel qGoodInp_def qPsubst_preserves_alpha1)
lemma qPsubstBinp_preserves_alphaBinp:
assumes "qGoodBinp qbinp ∨ qGoodBinp qbinp'" and "qGoodEnv qrho" and "qbinp %%= qbinp'"
shows "(qbinp %%[[qrho]]) %%= (qbinp' %%[[qrho]])"
using assms unfolding alphaBinp_def qPsubstBinp_def sameDom_def liftAll2_def
by (simp add: lift_None)
(smt liftAll_def lift_def option.case_eq_if option.exhaust_sel
option.sel qGoodBinp_def qPsubstAbs_preserves_alphaAbs1)
lemma qFreshInp_preserves_alphaInp_aux:
assumes good: "qGoodInp qinp ∨ qGoodInp qinp'" and alpha: "qinp %= qinp'"
and fresh: "qFreshInp xs x qinp"
shows "qFreshInp xs x qinp'"
using assms unfolding qFreshInp_def liftAll_def proof clarify
fix i qX' assume qinp': "qinp' i = Some qX'"
then obtain qX where qinp: "qinp i = Some qX"
using alpha unfolding alphaInp_def sameDom_def liftAll2_def by (cases "qinp i", auto)
hence "qGood qX ∨ qGood qX'"
using qinp' good unfolding qGoodInp_def liftAll_def by auto
moreover have "qX #= qX'"
using qinp qinp' alpha unfolding alphaInp_def sameDom_def liftAll2_def by auto
moreover have "qFresh xs x qX"
using fresh qinp unfolding qFreshInp_def liftAll_def by simp
ultimately show "qFresh xs x qX'"
using qFresh_preserves_alpha by auto
qed
lemma qFreshBinp_preserves_alphaBinp_aux:
assumes good: "qGoodBinp qbinp ∨ qGoodBinp qbinp'" and alpha: "qbinp %%= qbinp'"
and fresh: "qFreshBinp xs x qbinp"
shows "qFreshBinp xs x qbinp'"
using assms unfolding qFreshBinp_def liftAll_def proof clarify
fix i qA' assume qbinp': "qbinp' i = Some qA'"
then obtain qA where qbinp: "qbinp i = Some qA"
using alpha unfolding alphaBinp_def sameDom_def liftAll2_def by (cases "qbinp i", auto)
hence "qGoodAbs qA ∨ qGoodAbs qA'"
using qbinp' good unfolding qGoodBinp_def liftAll_def by auto
moreover have "qA $= qA'"
using qbinp qbinp' alpha unfolding alphaBinp_def sameDom_def liftAll2_def by auto
moreover have "qFreshAbs xs x qA"
using fresh qbinp unfolding qFreshBinp_def liftAll_def by simp
ultimately show "qFreshAbs xs x qA'"
using qFreshAbs_preserves_alphaAbs by auto
qed
lemma qFreshInp_preserves_alphaInp:
assumes "qGoodInp qinp ∨ qGoodInp qinp'" and "qinp %= qinp'"
shows "qFreshInp xs x qinp ⟷ qFreshInp xs x qinp'"
using alphaInp_sym assms qFreshInp_preserves_alphaInp_aux by blast
lemma qFreshBinp_preserves_alphaBinp:
assumes "qGoodBinp qbinp ∨ qGoodBinp qbinp'" and "qbinp %%= qbinp'"
shows "qFreshBinp xs x qbinp ⟷ qFreshBinp xs x qbinp'"
using alphaBinp_sym assms qFreshBinp_preserves_alphaBinp_aux by blast
lemmas qItem_simps =
qSkelAll_simps qFreshAll_simps qSwapAll_simps qPsubstAll_simps qGoodAll_simps alphaAll_Simps
qSwap_qAFresh_otherSimps qAFresh.simps qGoodItem.simps
end
subsection ‹Definitions of terms and their operators›
type_synonym ('index,'bindex,'varSort,'var,'opSym)"term" =
"('index,'bindex,'varSort,'var,'opSym)qTerm set"
type_synonym ('index,'bindex,'varSort,'var,'opSym)abs =
"('index,'bindex,'varSort,'var,'opSym)qAbs set"
type_synonym ('index,'bindex,'varSort,'var,'opSym)env =
"'varSort ⇒ 'var ⇒ ('index,'bindex,'varSort,'var,'opSym)term option"
text‹A ``parameter" will be something for which
freshness makes sense. Here is the most typical case of a parameter in proofs, putting
together (as lists) finite collections of variables, terms, abstractions and environments:›
datatype ('index,'bindex,'varSort,'var,'opSym)param =
Par "'var list"
"('index,'bindex,'varSort,'var,'opSym)term list"
"('index,'bindex,'varSort,'var,'opSym)abs list"
"('index,'bindex,'varSort,'var,'opSym)env list"
fun varsOf where
"varsOf (Par xL _ _ _) = set xL"
fun termsOf where
"termsOf (Par _ XL _ _) = set XL"
fun absOf where
"absOf (Par _ _ AL _) = set AL"
fun envsOf where
"envsOf (Par _ _ _ rhoL) = set rhoL"
context FixVars
begin
definition "alphaGood ≡ λ qX qY. qGood qX ∧ qGood qY ∧ qX #= qY"
definition "alphaAbsGood ≡ λ qA qB. qGoodAbs qA ∧ qGoodAbs qB ∧ qA $= qB"
definition "good ≡ qGood /// alphaGood"
definition "goodAbs ≡ qGoodAbs /// alphaAbsGood"
definition goodInp where
"goodInp inp ==
liftAll good inp ∧
|{i. inp i ≠ None}| <o |UNIV :: 'var set|"
definition goodBinp where
"goodBinp binp ==
liftAll goodAbs binp ∧
|{i. binp i ≠ None}| <o |UNIV :: 'var set|"
definition goodEnv where
"goodEnv rho ==
(∀ ys. liftAll good (rho ys)) ∧
(∀ ys. |{y. rho ys y ≠ None}| <o |UNIV :: 'var set| )"
definition asTerm where
"asTerm qX ≡ proj alphaGood qX"
definition asAbs where
"asAbs qA ≡ proj alphaAbsGood qA"
definition pickInp where
"pickInp inp ≡ lift pick inp"
definition pickBinp where
"pickBinp binp ≡ lift pick binp"
definition asInp where
"asInp qinp ≡ lift asTerm qinp"
definition asBinp where
"asBinp qbinp ≡ lift asAbs qbinp"
definition pickE where
"pickE rho ≡ λ xs. lift pick (rho xs)"
definition asEnv where
"asEnv qrho ≡ λ xs. lift asTerm (qrho xs)"
definition Var where
"Var xs x ≡ asTerm(qVar xs x)"
definition Op where
"Op delta inp binp ≡ asTerm (qOp delta (pickInp inp) (pickBinp binp))"
definition Abs where
"Abs xs x X ≡ asAbs (qAbs xs x (pick X))"
definition skel where
"skel X ≡ qSkel (pick X)"
definition skelAbs where
"skelAbs A ≡ qSkelAbs (pick A)"
definition skelInp where
"skelInp inp = qSkelInp (pickInp inp)"
definition skelBinp where
"skelBinp binp = qSkelBinp (pickBinp binp)"
lemma skelInp_def2:
assumes "goodInp inp"
shows "skelInp inp = lift skel inp"
unfolding skelInp_def
unfolding qSkelInp_def pickInp_def skel_def[abs_def]
unfolding lift_comp comp_def by simp
lemma skelBinp_def2:
assumes "goodBinp binp"
shows "skelBinp binp = lift skelAbs binp"
unfolding skelBinp_def
unfolding qSkelBinp_def pickBinp_def skelAbs_def[abs_def]
unfolding lift_comp comp_def by simp
definition swap where
"swap xs x y X = asTerm (qSwap xs x y (pick X))"
abbreviation swap_abbrev ("_ #[_ ∧ _]'__" 200) where
"(X #[z1 ∧ z2]_zs) ≡ swap zs z1 z2 X"
definition swapAbs where
"swapAbs xs x y A = asAbs (qSwapAbs xs x y (pick A))"
abbreviation swapAbs_abbrev ("_ $[_ ∧ _]'__" 200) where
"(A $[z1 ∧ z2]_zs) ≡ swapAbs zs z1 z2 A"
definition swapInp where
"swapInp xs x y inp ≡ lift (swap xs x y) inp"
definition swapBinp where
"swapBinp xs x y binp ≡ lift (swapAbs xs x y) binp"
abbreviation swapInp_abbrev ("_ %[_ ∧ _]'__" 200) where
"(inp %[z1 ∧ z2]_zs) ≡ swapInp zs z1 z2 inp"
abbreviation swapBinp_abbrev ("_ %%[_ ∧ _]'__" 200) where
"(binp %%[z1 ∧ z2]_zs) ≡ swapBinp zs z1 z2 binp"
definition swapEnvDom where
"swapEnvDom xs x y rho ≡ λzs z. rho zs (z @zs[x ∧ y]_xs)"
definition swapEnvIm where
"swapEnvIm xs x y rho ≡ λzs. lift (swap xs x y) (rho zs)"
definition swapEnv where
"swapEnv xs x y ≡ swapEnvIm xs x y o swapEnvDom xs x y"
abbreviation swapEnv_abbrev ("_ &[_ ∧ _]'__" 200) where
"(rho &[z1 ∧ z2]_zs) ≡ swapEnv zs z1 z2 rho"
lemmas swapEnv_defs = swapEnv_def comp_def swapEnvDom_def swapEnvIm_def
inductive_set swapped where
Refl: "(X,X) ∈ swapped"
|
Trans: "⟦(X,Y) ∈ swapped; (Y,Z) ∈ swapped⟧ ⟹ (X,Z) ∈ swapped"
|
Swap: "(X,Y) ∈ swapped ⟹ (X, Y #[x ∧ y]_zs) ∈ swapped"
lemmas swapped_Clauses = swapped.Refl swapped.Trans swapped.Swap
definition fresh where
"fresh xs x X ≡ qFresh xs x (pick X)"
definition freshAbs where
"freshAbs xs x A ≡ qFreshAbs xs x (pick A)"
definition freshInp where
"freshInp xs x inp ≡ liftAll (fresh xs x) inp"
definition freshBinp where
"freshBinp xs x binp ≡ liftAll (freshAbs xs x) binp"
definition freshEnv where
"freshEnv xs x rho ==
rho xs x = None ∧ (∀ ys. liftAll (fresh xs x) (rho ys))"
definition psubst where
"psubst rho X ≡ asTerm(qPsubst (pickE rho) (pick X))"
abbreviation psubst_abbrev ("_ #[_]") where
"(X #[rho]) ≡ psubst rho X"
definition psubstAbs where
"psubstAbs rho A ≡ asAbs(qPsubstAbs (pickE rho) (pick A))"
abbreviation psubstAbs_abbrev ("_ $[_]") where
"A $[rho] ≡ psubstAbs rho A"
definition psubstInp where
"psubstInp rho inp ≡ lift (psubst rho) inp"
definition psubstBinp where
"psubstBinp rho binp ≡ lift (psubstAbs rho) binp"
abbreviation psubstInp_abbrev ("_ %[_]") where
"inp %[rho] ≡ psubstInp rho inp"
abbreviation psubstBinp_abbrev ("_ %%[_]") where
"binp %%[rho] ≡ psubstBinp rho binp"
definition psubstEnv where
"psubstEnv rho rho' ≡
λ xs x. case rho' xs x of None ⇒ rho xs x
|Some X ⇒ Some (X #[rho])"
abbreviation psubstEnv_abbrev ("_ &[_]") where
"rho &[rho'] ≡ psubstEnv rho' rho"
definition idEnv where
"idEnv ≡ λxs. Map.empty"
definition updEnv ::
"('index,'bindex,'varSort,'var,'opSym)env ⇒
'var ⇒ ('index,'bindex,'varSort,'var,'opSym)term ⇒ 'varSort ⇒
('index,'bindex,'varSort,'var,'opSym)env"
("_ [_ ← _]'__" 200) where
"(rho [x ← X]_xs) ≡ λ ys y. (if ys = xs ∧ y = x then Some X else rho ys y)"
text‹(Unary) substitution:›
definition subst where
"subst xs X x ≡ psubst (idEnv [x ← X]_xs)"
abbreviation subst_abbrev ("_ #[_ '/ _]'__" 200) where
"(Y #[X / x]_xs) ≡ subst xs X x Y"
definition substAbs where
"substAbs xs X x ≡ psubstAbs (idEnv [x ← X]_xs)"
abbreviation substAbs_abbrev ("_ $[_ '/ _]'__" 200) where
"(A $[X / x]_xs) ≡ substAbs xs X x A"
definition substInp where
"substInp xs X x ≡ psubstInp (idEnv [x ← X]_xs)"
definition substBinp where
"substBinp xs X x ≡ psubstBinp (idEnv [x ← X]_xs)"
abbreviation substInp_abbrev ("_ %[_ '/ _]'__" 200) where
"(inp %[X / x]_xs) ≡ substInp xs X x inp"
abbreviation substBinp_abbrev ("_ %%[_ '/ _]'__" 200) where
"(binp %%[X / x]_xs) ≡ substBinp xs X x binp"
theorem substInp_def2:
"substInp ys Y y = lift (subst ys Y y)"
unfolding substInp_def[abs_def] subst_def psubstInp_def[abs_def] by simp
theorem substBinp_def2:
"substBinp ys Y y = lift (substAbs ys Y y)"
unfolding substBinp_def[abs_def] substAbs_def psubstBinp_def[abs_def] by simp
definition substEnv where
"substEnv xs X x ≡ psubstEnv (idEnv [x ← X]_xs)"
abbreviation substEnv_abbrev ("_ &[_ '/ _]'__" 200) where
"(Y &[X / x]_xs) ≡ substEnv xs X x Y"
theorem substEnv_def2:
"(rho &[Y / y]_ys) =
(λxs x. case rho xs x of
None ⇒ if (xs = ys ∧ x = y) then Some Y else None
|Some X ⇒ Some (X #[Y / y]_ys))"
unfolding substEnv_def psubstEnv_def subst_def idEnv_def updEnv_def
apply(rule ext)+ by(case_tac "rho xs x", simp_all)
text‹Variable-for-variable substitution:›
definition vsubst where
"vsubst ys y1 y2 ≡ subst ys (Var ys y1) y2"
abbreviation vsubst_abbrev ("_ #[_ '/'/ _]'__" 200) where
"(X #[y1 // y2]_ys) ≡ vsubst ys y1 y2 X"
definition vsubstAbs where
"vsubstAbs ys y1 y2 ≡ substAbs ys (Var ys y1) y2"
abbreviation vsubstAbs_abbrev ("_ $[_ '/'/ _]'__" 200) where
"(A $[y1 // y2]_ys) ≡ vsubstAbs ys y1 y2 A"
definition vsubstInp where
"vsubstInp ys y1 y2 ≡ substInp ys (Var ys y1) y2"
definition vsubstBinp where
"vsubstBinp ys y1 y2 ≡ substBinp ys (Var ys y1) y2"
abbreviation vsubstInp_abbrev ("_ %[_ '/'/ _]'__" 200) where
"(inp %[y1 // y2]_ys) ≡ vsubstInp ys y1 y2 inp"
abbreviation vsubstBinp_abbrev ("_ %%[_ '/'/ _]'__" 200) where
"(binp %%[y1 // y2]_ys) ≡ vsubstBinp ys y1 y2 binp"
lemma vsubstInp_def2:
"(inp %[y1 // y2]_ys) = lift (vsubst ys y1 y2) inp"
unfolding vsubstInp_def vsubst_def
by(auto simp add: substInp_def2)
lemma vsubstBinp_def2:
"(binp %%[y1 // y2]_ys) = lift (vsubstAbs ys y1 y2) binp"
unfolding vsubstBinp_def vsubstAbs_def
by(auto simp add: substBinp_def2)
definition vsubstEnv where
"vsubstEnv ys y1 y2 ≡ substEnv ys (Var ys y1) y2"
abbreviation vsubstEnv_abbrev ("_ &[_ '/'/ _]'__" 200) where
"(rho &[y1 // y2]_ys) ≡ vsubstEnv ys y1 y2 rho"
theorem vsubstEnv_def2:
"(rho &[y1 // y]_ys) =
(λxs x. case rho xs x of
None ⇒ if (xs = ys ∧ x = y) then Some (Var ys y1) else None
|Some X ⇒ Some (X #[y1 // y]_ys))"
unfolding vsubstEnv_def vsubst_def by(auto simp add: substEnv_def2)
definition goodPar where
"goodPar P ≡ (∀ X ∈ termsOf P. good X) ∧
(∀ A ∈ absOf P. goodAbs A) ∧
(∀ rho ∈ envsOf P. goodEnv rho)"
lemma Par_preserves_good[simp]:
assumes "!! X. X ∈ set XL ⟹ good X"
and "!! A. A ∈ set AL ⟹ goodAbs A"
and "!! rho. rho ∈ set rhoL ⟹ goodEnv rho"
shows "goodPar (Par xL XL AL rhoL)"
using assms unfolding goodPar_def by auto
lemma termsOf_preserves_good[simp]:
assumes "goodPar P" and "X : termsOf P"
shows "good X"
using assms unfolding goodPar_def by auto
lemma absOf_preserves_good[simp]:
assumes "goodPar P" and "A : absOf P"
shows "goodAbs A"
using assms unfolding goodPar_def by auto
lemma envsOf_preserves_good[simp]:
assumes "goodPar P" and "rho : envsOf P"
shows "goodEnv rho"
using assms unfolding goodPar_def by blast
lemmas param_simps =
termsOf.simps absOf.simps envsOf.simps
Par_preserves_good
termsOf_preserves_good absOf_preserves_good envsOf_preserves_good
subsection ‹Items versus quasi-items modulo alpha›
text‹Here we ``close the accounts" (for a while) with quasi-items --
beyond this subsection, there will not be any theorem that mentions
quasi-items, except much later when we deal with iteration principles
(and need to briefly switch back to quasi-terms in order to define the needed
iterative map by the universality of the alpha-quotient).›
subsubsection ‹For terms›
lemma alphaGood_equivP: "equivP qGood alphaGood"
unfolding equivP_def reflP_def symP_def transP_def alphaGood_def
using alpha_refl alpha_sym alpha_trans by blast
lemma univ_asTerm_alphaGood[simp]:
assumes *: "congruentP alphaGood f" and **: "qGood X"
shows "univ f (asTerm X) = f X"
by (metis assms alphaGood_equivP asTerm_def univ_commute)
corollary univ_asTerm_alpha[simp]:
assumes *: "congruentP alpha f" and **: "qGood X"
shows "univ f (asTerm X) = f X"
apply(rule univ_asTerm_alphaGood)
using assms unfolding alphaGood_def congruentP_def by auto
lemma pick_inj_on_good: "inj_on pick (Collect good)"
unfolding good_def using alphaGood_equivP equivP_pick_inj_on by auto
lemma pick_injective_good[simp]:
"⟦good X; good Y⟧ ⟹ (pick X = pick Y) = (X = Y)"
using pick_inj_on_good unfolding inj_on_def by auto
lemma good_imp_qGood_pick:
"good X ⟹ qGood (pick X)"
unfolding good_def
by (metis alphaGood_equivP equivP_pick_preserves)
lemma qGood_iff_good_asTerm:
"good (asTerm qX) = qGood qX"
unfolding good_def asTerm_def
using alphaGood_equivP proj_in_iff by fastforce
lemma pick_asTerm:
assumes "qGood qX"
shows "pick (asTerm qX) #= qX"
by (metis (full_types) alphaGood_def alphaGood_equivP asTerm_def assms pick_proj)
lemma asTerm_pick:
assumes "good X"
shows "asTerm (pick X) = X"
by (metis alphaGood_equivP asTerm_def assms good_def proj_pick)
lemma pick_alpha: "good X ⟹ pick X #= pick X"
using good_imp_qGood_pick alpha_refl by auto
lemma alpha_imp_asTerm_equal:
assumes "qGood qX" and "qX #= qY"
shows "asTerm qX = asTerm qY"
proof-
have "alphaGood qX qY" unfolding alphaGood_def using assms
by (metis alpha_preserves_qGood)
thus ?thesis unfolding asTerm_def using alphaGood_equivP proj_iff
by (metis alpha_preserves_qGood1 assms)
qed
lemma asTerm_equal_imp_alpha:
assumes "qGood qX" and "asTerm qX = asTerm qY"
shows "qX #= qY"
by (metis alphaAll_sym alphaAll_trans assms pick_asTerm qGood_iff_good_asTerm)
lemma asTerm_equal_iff_alpha:
assumes "qGood qX ∨ qGood qY"
shows "(asTerm qX = asTerm qY) = (qX #= qY)"
by (metis alpha_imp_asTerm_equal alpha_sym asTerm_equal_imp_alpha assms)
lemma pick_alpha_iff_equal:
assumes "good X" and "good Y"
shows "pick X #= pick Y ⟷ X = Y"
by (metis asTerm_equal_iff_alpha asTerm_pick assms good_imp_qGood_pick)
lemma pick_swap_qSwap:
assumes "good X"
shows "pick (X #[x1 ∧ x2]_xs) #= ((pick X) #[[x1 ∧ x2]]_xs)"
by (metis assms good_imp_qGood_pick pick_asTerm qSwap_preserves_qGood1 swap_def)
lemma asTerm_qSwap_swap:
assumes "qGood qX"
shows "asTerm (qX #[[x1 ∧ x2]]_xs) = ((asTerm qX) #[x1 ∧ x2]_xs)"
by (simp add: alpha_imp_asTerm_equal alpha_sym assms local.swap_def
pick_asTerm qSwap_preserves_alpha qSwap_preserves_qGood1)
lemma fresh_asTerm_qFresh:
assumes "qGood qX"
shows "fresh xs x (asTerm qX) = qFresh xs x qX"
by (simp add: assms fresh_def pick_asTerm qFresh_preserves_alpha)
lemma skel_asTerm_qSkel:
assumes "qGood qX"
shows "skel (asTerm qX) = qSkel qX"
by (simp add: alpha_qSkel assms pick_asTerm skel_def)
lemma double_swap_qSwap:
assumes "good X"
shows "qGood (((pick X) #[[x ∧ y]]_zs) #[[x' ∧ y']]_zs') ∧
((X #[x ∧ y]_zs) #[x' ∧ y']_zs') = asTerm (((pick X) #[[x ∧ y]]_zs) #[[x' ∧ y']]_zs')"
by (simp add: asTerm_qSwap_swap assms
good_imp_qGood_pick local.swap_def qSwap_preserves_qGood1)
lemma fresh_swap_qFresh_qSwap:
assumes "good X"
shows "fresh xs x (X #[y1 ∧ y2]_ys) = qFresh xs x ((pick X) #[[y1 ∧ y2]]_ys)"
by (simp add: assms
fresh_asTerm_qFresh good_imp_qGood_pick local.swap_def qSwap_preserves_qGood)
subsubsection ‹For abstractions›
lemma alphaAbsGood_equivP: "equivP qGoodAbs alphaAbsGood"
unfolding equivP_def reflP_def symP_def transP_def alphaAbsGood_def
using alphaAbs_refl alphaAbs_sym alphaAbs_trans by blast
lemma univ_asAbs_alphaAbsGood[simp]:
assumes "fAbs respectsP alphaAbsGood" and "qGoodAbs A"
shows "univ fAbs (asAbs A) = fAbs A"
by (metis assms alphaAbsGood_equivP asAbs_def univ_commute)
corollary univ_asAbs_alphaAbs[simp]:
assumes *: "fAbs respectsP alphaAbs" and **: "qGoodAbs A"
shows "univ fAbs (asAbs A) = fAbs A"
apply(rule univ_asAbs_alphaAbsGood)
using assms unfolding alphaAbsGood_def congruentP_def by auto
lemma pick_inj_on_goodAbs: "inj_on pick (Collect goodAbs)"
unfolding goodAbs_def using alphaAbsGood_equivP equivP_pick_inj_on by auto
lemma pick_injective_goodAbs[simp]:
"⟦goodAbs A; goodAbs B⟧ ⟹ pick A = pick B ⟷ A = B"
using pick_inj_on_goodAbs unfolding inj_on_def by auto
lemma goodAbs_imp_qGoodAbs_pick:
"goodAbs A ⟹ qGoodAbs (pick A)"
unfolding goodAbs_def
using alphaAbsGood_equivP equivP_pick_preserves by fastforce
lemma qGoodAbs_iff_goodAbs_asAbs:
"goodAbs(asAbs qA) = qGoodAbs qA"
unfolding goodAbs_def asAbs_def
using alphaAbsGood_equivP proj_in_iff by fastforce
lemma pick_asAbs:
assumes "qGoodAbs qA"
shows "pick (asAbs qA) $= qA"
by (metis (full_types) alphaAbsGood_def alphaAbsGood_equivP asAbs_def assms pick_proj)
lemma asAbs_pick:
assumes "goodAbs A"
shows "asAbs (pick A) = A"
by (metis alphaAbsGood_equivP asAbs_def assms goodAbs_def proj_pick)
lemma pick_alphaAbs: "goodAbs A ⟹ pick A $= pick A"
using goodAbs_imp_qGoodAbs_pick alphaAbs_refl by auto
lemma alphaAbs_imp_asAbs_equal:
assumes "qGoodAbs qA" and "qA $= qB"
shows "asAbs qA = asAbs qB"
by (metis (no_types, hide_lams) proj_iff alphaAbsGood_def alphaAbsGood_equivP
alphaAbs_preserves_qGoodAbs asAbs_def assms)
lemma asAbs_equal_imp_alphaAbs:
assumes "qGoodAbs qA" and "asAbs qA = asAbs qB"
shows "qA $= qB"
by (metis alphaAbs_refl
alphaAbs_sym alphaAbs_trans_twice assms pick_asAbs qGoodAbs_iff_goodAbs_asAbs)
lemma asAbs_equal_iff_alphaAbs:
assumes "qGoodAbs qA ∨ qGoodAbs qB"
shows "(asAbs qA = asAbs qB) = (qA $= qB)"
by (metis alphaAbs_imp_asAbs_equal alphaAbs_preserves_qGoodAbs
asAbs_equal_imp_alphaAbs assms)
lemma pick_alphaAbs_iff_equal:
assumes "goodAbs A" and "goodAbs B"
shows "(pick A $= pick B) = (A = B)"
using asAbs_equal_iff_alphaAbs asAbs_pick assms goodAbs_imp_qGoodAbs_pick by blast
lemma pick_swapAbs_qSwapAbs:
assumes "goodAbs A"
shows "pick (A $[x1 ∧ x2]_xs) $= ((pick A) $[[x1 ∧ x2]]_xs)"
by (simp add: assms goodAbs_imp_qGoodAbs_pick
pick_asAbs qSwapAbs_preserves_qGoodAbs swapAbs_def)
lemma asAbs_qSwapAbs_swapAbs:
assumes "qGoodAbs qA"
shows "asAbs (qA $[[x1 ∧ x2]]_xs) = ((asAbs qA) $[x1 ∧ x2]_xs)"
by (simp add: alphaAbs_imp_asAbs_equal alphaAbs_sym assms pick_asAbs
qSwapAbs_preserves_alphaAbs
qSwapAbs_preserves_qGoodAbs1 swapAbs_def)
lemma freshAbs_asAbs_qFreshAbs:
assumes "qGoodAbs qA"
shows "freshAbs xs x (asAbs qA) = qFreshAbs xs x qA"
by (simp add: assms freshAbs_def pick_asAbs qFreshAbs_preserves_alphaAbs)
lemma skelAbs_asAbs_qSkelAbs:
assumes "qGoodAbs qA"
shows "skelAbs (asAbs qA) = qSkelAbs qA"
by (simp add: alphaAll_qSkelAll assms pick_asAbs skelAbs_def)
subsubsection ‹For inputs›
text ‹For unbound inputs:›
lemma pickInp_inj_on_goodInp: "inj_on pickInp (Collect goodInp)"
unfolding pickInp_def[abs_def] inj_on_def
proof(safe, rule ext)
fix inp inp' i
assume good: "goodInp inp" "goodInp inp'" and *: "lift pick inp = lift pick inp'"
show "inp i = inp' i"
proof(cases "inp i")
assume inp: "inp i = None"
hence "lift pick inp i = None" by (auto simp add: lift_None)
hence "lift pick inp' i = None" using * by simp
hence "inp' i = None" by (auto simp add: lift_None)
thus ?thesis using inp by simp
next
fix X assume inp: "inp i = Some X"
hence "lift pick inp i = Some (pick X)" unfolding lift_def by simp
hence "lift pick inp' i = Some (pick X)" using * by simp
then obtain X' where inp': "inp' i = Some X'" and XX': "pick X = pick X'"
unfolding lift_def by(cases "inp' i", auto)
hence "good X ∧ good X'"
using inp good goodInp_def liftAll_def by (metis (hide_lams, full_types))
hence "X = X'" using XX' by auto
thus ?thesis unfolding inp inp' by simp
qed
qed
lemma goodInp_imp_qGoodInp_pickInp:
assumes "goodInp inp"
shows "qGoodInp (pickInp inp)"
unfolding pickInp_def qGoodInp_def liftAll_def
proof safe
fix i qX assume "lift pick inp i = Some qX"
then obtain X where inp: "inp i = Some X" and qX: "qX = pick X"
unfolding lift_def by(cases "inp i", auto)
hence "good X" using assms
unfolding goodInp_def liftAll_def by simp
thus "qGood qX" unfolding qX using good_imp_qGood_pick by auto
next
fix xs let ?Left = "{i. lift pick inp i ≠ None}"
have "?Left = {i. inp i ≠ None}" by(force simp add: lift_None)
thus "|?Left| <o |UNIV :: 'var set|" using assms unfolding goodInp_def by auto
qed
lemma qGoodInp_iff_goodInp_asInp:
"goodInp (asInp qinp) = qGoodInp qinp"
proof(unfold asInp_def)
let ?inp = "lift asTerm qinp"
{assume qgood_qinp: "qGoodInp qinp"
have "goodInp ?inp"
unfolding goodInp_def liftAll_def proof safe
fix i X assume inp: "?inp i = Some X"
then obtain qX where qinp: "qinp i = Some qX" and X: "X = asTerm qX"
unfolding lift_def by(cases "qinp i", auto)
hence "qGood qX"
using qgood_qinp unfolding qGoodInp_def liftAll_def by auto
thus "good X" using X qGood_iff_good_asTerm by auto
next
fix xs let ?Left = "{i. lift asTerm qinp i ≠ None}"
have "?Left = {i. qinp i ≠ None}" by(auto simp add: lift_None)
thus "|?Left| <o |UNIV :: 'var set|" using qgood_qinp unfolding qGoodInp_def by auto
qed
}
moreover
{assume good_inp: "goodInp ?inp"
have "qGoodInp qinp"
unfolding qGoodInp_def liftAll_def proof safe
fix i qX assume qinp: "qinp i = Some qX" let ?X = "asTerm qX"
have inp: "?inp i = Some ?X" unfolding lift_def using qinp by simp
hence "good ?X"
using good_inp unfolding goodInp_def liftAll_def by auto
thus "qGood qX" using qGood_iff_good_asTerm by auto
next
fix xs let ?Left = "{i. qinp i ≠ None}"
have "?Left = {i. lift asTerm qinp i ≠ None}" by(auto simp add: lift_None)
thus "|?Left| <o |UNIV :: 'var set|" using good_inp unfolding goodInp_def by auto
qed
}
ultimately show "goodInp ?inp = qGoodInp qinp" by blast
qed
lemma pickInp_asInp:
assumes "qGoodInp qinp"
shows "pickInp (asInp qinp) %= qinp"
using assms unfolding pickInp_def asInp_def lift_comp
by (smt CollectI alphaInp_def asTerm_equal_iff_alpha asTerm_pick case_prodI comp_apply liftAll2_def liftAll_def lift_def option.case(2) option.sel qGoodInp_def qGood_iff_good_asTerm
sameDom_lift2)
lemma asInp_pickInp:
assumes "goodInp inp"
shows "asInp (pickInp inp) = inp"
unfolding asInp_def pickInp_def lift_comp
proof(rule ext)
fix i show "lift (asTerm ∘ pick) inp i = inp i"
unfolding lift_def proof(cases "inp i", simp+)
fix X assume "inp i = Some X"
hence "good X" using assms unfolding goodInp_def liftAll_def by simp
thus "asTerm (pick X) = X" using asTerm_pick by auto
qed
qed
lemma pickInp_alphaInp:
assumes goodInp: "goodInp inp"
shows "pickInp inp %= pickInp inp"
using assms goodInp_imp_qGoodInp_pickInp alphaInp_refl by auto
lemma alphaInp_imp_asInp_equal:
assumes "qGoodInp qinp" and "qinp %= qinp'"
shows "asInp qinp = asInp qinp'"
unfolding asInp_def proof(rule ext)
fix i show "lift asTerm qinp i = lift asTerm qinp' i"
proof(cases "qinp i")
assume Case1: "qinp i = None"
hence "qinp' i = None"
using assms unfolding alphaInp_def sameDom_def liftAll2_def by auto
thus ?thesis using Case1 unfolding lift_def by simp
next
fix qX assume Case2: "qinp i = Some qX"
then obtain qX' where qinp': "qinp' i = Some qX'"
using assms unfolding alphaInp_def sameDom_def liftAll2_def by (cases "qinp' i", force)
hence "qX #= qX'"
using assms Case2 unfolding alphaInp_def sameDom_def liftAll2_def by auto
moreover have "qGood qX" using assms Case2 unfolding qGoodInp_def liftAll_def by auto
ultimately show ?thesis
using Case2 qinp' alpha_imp_asTerm_equal unfolding lift_def by auto
qed
qed
lemma asInp_equal_imp_alphaInp:
assumes "qGoodInp qinp" and "asInp qinp = asInp qinp'"
shows "qinp %= qinp'"
using assms unfolding alphaInp_def liftAll2_def sameDom_def
by simp (smt asInp_def asTerm_equal_iff_alpha liftAll_def lift_def option.case(2)
option.sel qGoodInp_def sameDom_def sameDom_lift2)
lemma asInp_equal_iff_alphaInp:
"qGoodInp qinp ⟹ (asInp qinp = asInp qinp') = (qinp %= qinp')"
using asInp_equal_imp_alphaInp alphaInp_imp_asInp_equal by blast
lemma pickInp_alphaInp_iff_equal:
assumes "goodInp inp" and "goodInp inp'"
shows "(pickInp inp %= pickInp inp') = (inp = inp')"
by (metis alphaInp_imp_asInp_equal asInp_equal_imp_alphaInp
asInp_pickInp assms goodInp_imp_qGoodInp_pickInp)
lemma pickInp_swapInp_qSwapInp:
assumes "goodInp inp"
shows "pickInp (inp %[x1 ∧ x2]_xs) %= ((pickInp inp) %[[x1 ∧ x2]]_xs)"
using assms unfolding alphaInp_def sameDom_def liftAll2_def
pickInp_def swapInp_def qSwapInp_def lift_comp
by (simp add: lift_None)
(smt assms comp_apply goodInp_imp_qGoodInp_pickInp liftAll_def lift_def local.swap_def option.case_eq_if option.sel option.simps(3) pickInp_def
pick_asTerm qGoodInp_def qSwap_preserves_qGood1)
lemma asInp_qSwapInp_swapInp:
assumes "qGoodInp qinp"
shows "asInp (qinp %[[x1 ∧ x2]]_xs) = ((asInp qinp) %[x1 ∧ x2]_xs)"
proof-
{fix i qX assume "qinp i = Some qX"
hence "qGood qX" using assms unfolding qGoodInp_def liftAll_def by auto
hence "asTerm (qX #[[x1 ∧ x2]]_xs) = swap xs x1 x2 (asTerm qX)"
by(auto simp add: asTerm_qSwap_swap)
}
thus ?thesis
using assms
by (smt asInp_def comp_apply lift_comp lift_cong qSwapInp_def swapInp_def)
qed
lemma swapInp_def2:
"(inp %[x1 ∧ x2]_xs) = asInp ((pickInp inp) %[[x1 ∧ x2]]_xs)"
unfolding swapInp_def asInp_def pickInp_def qSwapInp_def lift_def swap_def
apply(rule ext) subgoal for i by (cases "inp i") auto .
lemma freshInp_def2:
"freshInp xs x inp = qFreshInp xs x (pickInp inp)"
unfolding freshInp_def qFreshInp_def pickInp_def lift_def fresh_def liftAll_def
apply(rule iff_allI) subgoal for i by (cases "inp i") auto .
text ‹For bound inputs:›
lemma pickBinp_inj_on_goodBinp: "inj_on pickBinp (Collect goodBinp)"
unfolding pickBinp_def[abs_def] inj_on_def
proof(safe, rule ext)
fix binp binp' i
assume good: "goodBinp binp" "goodBinp binp'" and *: "lift pick binp = lift pick binp'"
show "binp i = binp' i"
proof(cases "binp i")
assume binp: "binp i = None"
hence "lift pick binp i = None" by (auto simp add: lift_None)
hence "lift pick binp' i = None" using * by simp
hence "binp' i = None" by (auto simp add: lift_None)
thus ?thesis using binp by simp
next
fix A assume binp: "binp i = Some A"
hence "lift pick binp i = Some (pick A)" unfolding lift_def by simp
hence "lift pick binp' i = Some (pick A)" using * by simp
then obtain A' where binp': "binp' i = Some A'" and AA': "pick A = pick A'"
unfolding lift_def by(cases "binp' i", auto)
hence "goodAbs A ∧ goodAbs A'"
using binp good goodBinp_def liftAll_def by (metis (hide_lams, full_types))
hence "A = A'" using AA' by auto
thus ?thesis unfolding binp binp' by simp
qed
qed
lemma goodBinp_imp_qGoodBinp_pickBinp:
assumes "goodBinp binp"
shows "qGoodBinp (pickBinp binp)"
unfolding pickBinp_def qGoodBinp_def liftAll_def proof safe
fix i qA assume "lift pick binp i = Some qA"
then obtain A where binp: "binp i = Some A" and qA: "qA = pick A"
unfolding lift_def by(cases "binp i", auto)
hence "goodAbs A" using assms
unfolding goodBinp_def liftAll_def by simp
thus "qGoodAbs qA" unfolding qA using goodAbs_imp_qGoodAbs_pick by auto
next
fix xs let ?Left = "{i. lift pick binp i ≠ None}"
have "?Left = {i. binp i ≠ None}" by(force simp add: lift_None)
thus "|?Left| <o |UNIV :: 'var set|" using assms unfolding goodBinp_def by auto
qed
lemma qGoodBinp_iff_goodBinp_asBinp:
"goodBinp (asBinp qbinp) = qGoodBinp qbinp"
proof(unfold asBinp_def)
let ?binp = "lift asAbs qbinp"
{assume qgood_qbinp: "qGoodBinp qbinp"
have "goodBinp ?binp"
unfolding goodBinp_def liftAll_def proof safe
fix i A assume binp: "?binp i = Some A"
then obtain qA where qbinp: "qbinp i = Some qA" and A: "A = asAbs qA"
unfolding lift_def by(cases "qbinp i", auto)
hence "qGoodAbs qA"
using qgood_qbinp unfolding qGoodBinp_def liftAll_def by auto
thus "goodAbs A" using A qGoodAbs_iff_goodAbs_asAbs by auto
next
fix xs let ?Left = "{i. lift asAbs qbinp i ≠ None}"
have "?Left = {i. qbinp i ≠ None}" by(auto simp add: lift_None)
thus "|?Left| <o |UNIV :: 'var set|" using qgood_qbinp unfolding qGoodBinp_def by auto
qed
}
moreover
{assume good_binp: "goodBinp ?binp"
have "qGoodBinp qbinp"
unfolding qGoodBinp_def liftAll_def proof safe
fix i qA assume qbinp: "qbinp i = Some qA" let ?A = "asAbs qA"
have binp: "?binp i = Some ?A" unfolding lift_def using qbinp by simp
hence "goodAbs ?A"
using good_binp unfolding goodBinp_def liftAll_def by auto
thus "qGoodAbs qA" using qGoodAbs_iff_goodAbs_asAbs by auto
next
fix xs let ?Left = "{i. qbinp i ≠ None}"
have "?Left = {i. lift asAbs qbinp i ≠ None}" by(auto simp add: lift_None)
thus "|?Left| <o |UNIV :: 'var set|" using good_binp unfolding goodBinp_def by auto
qed
}
ultimately show "goodBinp ?binp = qGoodBinp qbinp" by blast
qed
lemma pickBinp_asBinp:
assumes "qGoodBinp qbinp"
shows "pickBinp (asBinp qbinp) %%= qbinp"
unfolding pickBinp_def asBinp_def lift_comp alphaBinp_def using sameDom_lift2
by auto (smt assms comp_apply liftAll2_def liftAll_def
lift_def option.sel option.simps(5) pick_asAbs qGoodBinp_def)
lemma asBinp_pickBinp:
assumes "goodBinp binp"
shows "asBinp (pickBinp binp) = binp"
unfolding asBinp_def pickBinp_def lift_comp
apply(rule ext)
subgoal for i apply(cases "binp i")
using assms asAbs_pick unfolding goodBinp_def liftAll_def lift_def by auto .
lemma pickBinp_alphaBinp:
assumes goodBinp: "goodBinp binp"
shows "pickBinp binp %%= pickBinp binp"
using assms goodBinp_imp_qGoodBinp_pickBinp alphaBinp_refl by auto
lemma alphaBinp_imp_asBinp_equal:
assumes "qGoodBinp qbinp" and "qbinp %%= qbinp'"
shows "asBinp qbinp = asBinp qbinp'"
unfolding asBinp_def proof(rule ext)
fix i show "lift asAbs qbinp i = lift asAbs qbinp' i"
proof(cases "qbinp i")
case None
hence "qbinp' i = None"
using assms unfolding alphaBinp_def sameDom_def liftAll2_def by auto
thus ?thesis using None unfolding lift_def by simp
next
case (Some qA)
then obtain qA' where qbinp': "qbinp' i = Some qA'"
using assms unfolding alphaBinp_def sameDom_def liftAll2_def by (cases "qbinp' i", force)
hence "qA $= qA'"
using assms Some unfolding alphaBinp_def sameDom_def liftAll2_def by auto
moreover have "qGoodAbs qA" using assms Some unfolding qGoodBinp_def liftAll_def by auto
ultimately show ?thesis
using Some qbinp' alphaAbs_imp_asAbs_equal unfolding lift_def by auto
qed
qed
lemma asBinp_equal_imp_alphaBinp:
assumes "qGoodBinp qbinp" and "asBinp qbinp = asBinp qbinp'"
shows "qbinp %%= qbinp'"
using assms unfolding alphaBinp_def liftAll2_def sameDom_def
by simp (smt asAbs_equal_imp_alphaAbs asBinp_def liftAll_def
lift_None lift_def option.inject option.simps(5) qGoodBinp_def)
lemma asBinp_equal_iff_alphaBinp:
"qGoodBinp qbinp ⟹ (asBinp qbinp = asBinp qbinp') = (qbinp %%= qbinp')"
using asBinp_equal_imp_alphaBinp alphaBinp_imp_asBinp_equal by blast
lemma pickBinp_alphaBinp_iff_equal:
assumes "goodBinp binp" and "goodBinp binp'"
shows "(pickBinp binp %%= pickBinp binp') = (binp = binp')"
using assms goodBinp_imp_qGoodBinp_pickBinp asBinp_pickBinp pickBinp_alphaBinp
by (metis asBinp_equal_iff_alphaBinp)
lemma pickBinp_swapBinp_qSwapBinp:
assumes "goodBinp binp"
shows "pickBinp (binp %%[x1 ∧ x2]_xs) %%= ((pickBinp binp) %%[[x1 ∧ x2]]_xs)"
using assms unfolding pickBinp_def swapBinp_def qSwapBinp_def lift_comp
alphaBinp_def sameDom_def liftAll2_def
by (simp add: goodBinp_def liftAll_def lift_def option.case_eq_if pick_swapAbs_qSwapAbs)
lemma asBinp_qSwapBinp_swapBinp:
assumes "qGoodBinp qbinp"
shows "asBinp (qbinp %%[[x1 ∧ x2]]_xs) = ((asBinp qbinp) %%[x1 ∧ x2]_xs)"
unfolding asBinp_def swapBinp_def qSwapBinp_def lift_comp alphaBinp_def lift_def
apply(rule ext) subgoal for i apply(cases "qbinp i")
using assms asAbs_qSwapAbs_swapAbs by (fastforce simp add: liftAll_def qGoodBinp_def)+ .
lemma swapBinp_def2:
"(binp %%[x1 ∧ x2]_xs) = asBinp ((pickBinp binp) %%[[x1 ∧ x2]]_xs)"
unfolding swapBinp_def asBinp_def pickBinp_def qSwapBinp_def lift_def swapAbs_def
apply (rule ext) subgoal for i by (cases "binp i") simp_all .
lemma freshBinp_def2:
"freshBinp xs x binp = qFreshBinp xs x (pickBinp binp)"
unfolding freshBinp_def qFreshBinp_def pickBinp_def lift_def freshAbs_def liftAll_def
apply (rule iff_allI) subgoal for i by (cases "binp i") simp_all .
subsubsection ‹For environments›
lemma goodEnv_imp_qGoodEnv_pickE:
assumes "goodEnv rho"
shows "qGoodEnv (pickE rho)"
unfolding qGoodEnv_def pickE_def
apply(auto simp del: "not_None_eq")
using assms good_imp_qGood_pick unfolding liftAll_lift_comp comp_def
by (auto simp: goodEnv_def liftAll_def lift_None)
lemma qGoodEnv_iff_goodEnv_asEnv:
"goodEnv (asEnv qrho) = qGoodEnv qrho"
unfolding asEnv_def unfolding goodEnv_def liftAll_lift_comp comp_def
by (auto simp: qGoodEnv_def lift_None liftAll_def qGood_iff_good_asTerm)
lemma pickE_asEnv:
assumes "qGoodEnv qrho"
shows "pickE (asEnv qrho) &= qrho"
using assms
by (auto simp: lift_None liftAll_def lift_def alphaEnv_def sameDom_def liftAll2_def
pick_asTerm qGoodEnv_def pickE_def asEnv_def split: option.splits)
lemma asEnv_pickE:
assumes "goodEnv rho" shows "asEnv (pickE rho) xs x = rho xs x"
using assms asTerm_pick
by (cases "rho xs x") (auto simp: goodEnv_def liftAll_def asEnv_def pickE_def lift_comp lift_def)
lemma pickE_alphaEnv:
assumes goodEnv: "goodEnv rho" shows "pickE rho &= pickE rho"
using assms goodEnv_imp_qGoodEnv_pickE alphaEnv_refl by auto
lemma alphaEnv_imp_asEnv_equal:
assumes "qGoodEnv qrho" and "qrho &= qrho'"
shows "asEnv qrho = asEnv qrho'"
apply (rule ext)+ subgoal for xs x apply(cases "qrho xs x")
using assms asTerm_equal_iff_alpha alpha_imp_asTerm_equal
by (auto simp add: alphaEnv_def sameDom_def asEnv_def lift_def
qGoodEnv_def liftAll_def liftAll2_def option.case_eq_if split: option.splits)
blast+ .
lemma asEnv_equal_imp_alphaEnv:
assumes "qGoodEnv qrho" and "asEnv qrho = asEnv qrho'"
shows "qrho &= qrho'"
using assms unfolding alphaEnv_def sameDom_def liftAll2_def
apply (simp add: asEnv_def lift_None lift_def qGoodEnv_def liftAll_def)
by (smt asTerm_equal_imp_alpha option.sel option.simps(5) option.case_eq_if option.distinct(1))
lemma asEnv_equal_iff_alphaEnv:
"qGoodEnv qrho ⟹ (asEnv qrho = asEnv qrho') = (qrho &= qrho')"
using asEnv_equal_imp_alphaEnv alphaEnv_imp_asEnv_equal by blast
lemma pickE_alphaEnv_iff_equal:
assumes "goodEnv rho" and "goodEnv rho'"
shows "(pickE rho &= pickE rho') = (rho = rho')"
proof(rule iffI, safe, (rule ext)+)
fix xs x
assume alpha: "pickE rho &= pickE rho'"
have qgood_rho: "qGoodEnv (pickE rho)" using assms goodEnv_imp_qGoodEnv_pickE by auto
have "rho xs x = asEnv (pickE rho) xs x" using assms asEnv_pickE by fastforce
also have "… = asEnv (pickE rho') xs x"
using qgood_rho alpha alphaEnv_imp_asEnv_equal by fastforce
also have "… = rho' xs x" using assms asEnv_pickE by fastforce
finally show "rho xs x = rho' xs x" .
next
have "qGoodEnv(pickE rho')" using assms goodEnv_imp_qGoodEnv_pickE by auto
thus "pickE rho' &= pickE rho'" using alphaEnv_refl by auto
qed
lemma freshEnv_def2:
"freshEnv xs x rho = qFreshEnv xs x (pickE rho)"
unfolding freshEnv_def qFreshEnv_def pickE_def lift_def fresh_def liftAll_def
apply(cases "rho xs x")
by (auto intro!: iff_allI) (metis map_option_case map_option_eq_Some)
lemma pick_psubst_qPsubst:
assumes "good X" and "goodEnv rho"
shows "pick (X #[rho]) #= ((pick X) #[[pickE rho]])"
by (simp add: assms goodEnv_imp_qGoodEnv_pickE good_imp_qGood_pick
pick_asTerm psubst_def qPsubst_preserves_qGood)
lemma pick_psubstAbs_qPsubstAbs:
assumes "goodAbs A" and "goodEnv rho"
shows "pick (A $[rho]) $= ((pick A) $[[pickE rho]])"
by (simp add: assms goodAbs_imp_qGoodAbs_pick goodEnv_imp_qGoodEnv_pickE pick_asAbs
psubstAbs_def qPsubstAbs_preserves_qGoodAbs)
lemma pickInp_psubstInp_qPsubstInp:
assumes good: "goodInp inp" and good_rho: "goodEnv rho"
shows "pickInp (inp %[rho]) %= ((pickInp inp) %[[pickE rho]])"
using assms unfolding pickInp_def psubstInp_def qPsubstInp_def lift_comp
unfolding alphaInp_def sameDom_def liftAll2_def
by (simp add: lift_None)
(smt comp_apply goodEnv_imp_qGoodEnv_pickE goodInp_imp_qGoodInp_pickInp liftAll_def lift_def map_option_case map_option_eq_Some option.sel pickInp_def
pick_asTerm psubst_def qGoodInp_def qPsubst_preserves_qGood)
lemma pickBinp_psubstBinp_qPsubstBinp:
assumes good: "goodBinp binp" and good_rho: "goodEnv rho"
shows "pickBinp (binp %%[rho]) %%= ((pickBinp binp) %%[[pickE rho]])"
using assms unfolding pickBinp_def psubstBinp_def qPsubstBinp_def lift_comp
unfolding alphaBinp_def sameDom_def liftAll2_def
by (simp add: lift_None)
(smt comp_apply goodBinp_def liftAll_def lift_def map_option_case map_option_eq_Some
option.sel pick_psubstAbs_qPsubstAbs)
subsubsection‹The structural alpha-equivPalence maps commute with the syntactic constructs›
lemma pick_Var_qVar:
"pick (Var xs x) #= qVar xs x"
unfolding Var_def using pick_asTerm by force
lemma Op_asInp_asTerm_qOp:
assumes "qGoodInp qinp" and "qGoodBinp qbinp"
shows "Op delta (asInp qinp) (asBinp qbinp) = asTerm (qOp delta qinp qbinp)"
using assms pickInp_asInp pickBinp_asBinp unfolding Op_def
by(auto simp add: asTerm_equal_iff_alpha)
lemma qOp_pickInp_pick_Op:
assumes "goodInp inp" and "goodBinp binp"
shows "qOp delta (pickInp inp) (pickBinp binp) #= pick (Op delta inp binp)"
using assms goodInp_imp_qGoodInp_pickInp goodBinp_imp_qGoodBinp_pickBinp
unfolding Op_def using pick_asTerm alpha_sym by force
lemma Abs_asTerm_asAbs_qAbs:
assumes "qGood qX"
shows "Abs xs x (asTerm qX) = asAbs (qAbs xs x qX)"
using assms pick_asTerm qAbs_preserves_alpha unfolding Abs_def
by(force simp add: asAbs_equal_iff_alphaAbs)
lemma qAbs_pick_Abs:
assumes "good X"
shows "qAbs xs x (pick X) $= pick (Abs xs x X)"
using assms good_imp_qGood_pick pick_asAbs alphaAbs_sym unfolding Abs_def by force
lemmas qItem_versus_item_simps =
univ_asTerm_alphaGood univ_asAbs_alphaAbsGood
univ_asTerm_alpha univ_asAbs_alphaAbs
pick_injective_good pick_injective_goodAbs
subsection ‹All operators preserve the ``good'' predicate›
lemma Var_preserves_good[simp]:
"good(Var xs x::('index,'bindex,'varSort,'var,'opSym)term)"
by (metis Var_def qGood.simps(1) qGood_iff_good_asTerm)
lemma Op_preserves_good[simp]:
assumes "goodInp inp" and "goodBinp binp"
shows "good(Op delta inp binp)"
using assms goodInp_imp_qGoodInp_pickInp goodBinp_imp_qGoodBinp_pickBinp
qGood_iff_good_asTerm unfolding Op_def by fastforce
lemma Abs_preserves_good[simp]:
assumes good: "good X"
shows "goodAbs(Abs xs x X)"
using assms good_imp_qGood_pick qGoodAbs_iff_goodAbs_asAbs
unfolding Abs_def by fastforce
lemmas Cons_preserve_good =
Var_preserves_good Op_preserves_good Abs_preserves_good
lemma swap_preserves_good[simp]:
assumes "good X"
shows "good (X #[x ∧ y]_xs)"
using assms good_imp_qGood_pick qSwap_preserves_qGood qGood_iff_good_asTerm
unfolding swap_def by fastforce
lemma swapAbs_preserves_good[simp]:
assumes "goodAbs A"
shows "goodAbs (A $[x ∧ y]_xs)"
using assms goodAbs_imp_qGoodAbs_pick qSwapAbs_preserves_qGoodAbs qGoodAbs_iff_goodAbs_asAbs
unfolding swapAbs_def by fastforce
lemma swapInp_preserves_good[simp]:
assumes "goodInp inp"
shows "goodInp (inp %[x ∧ y]_xs)"
using assms
by (auto simp: goodInp_def lift_def swapInp_def liftAll_def split: option.splits)
lemma swapBinp_preserves_good[simp]:
assumes "goodBinp binp"
shows "goodBinp (binp %%[x ∧ y]_xs)"
using assms
by (auto simp: goodBinp_def lift_def swapBinp_def liftAll_def split: option.splits)
lemma swapEnvDom_preserves_good:
assumes "goodEnv rho"
shows "goodEnv (swapEnvDom xs x y rho)" (is "goodEnv ?rho'")
unfolding goodEnv_def liftAll_def proof safe
fix zs z X' assume rho': "?rho' zs z = Some X'"
hence "rho zs (z @zs[x ∧ y]_xs) = Some X'" unfolding swapEnvDom_def by simp
thus "good X'" using assms unfolding goodEnv_def liftAll_def by simp
next
fix xsa ys let ?Left = "{ya. ?rho' ys ya ≠ None}"
have "|{y} ∪ {ya. rho ys ya ≠ None}| <o |UNIV :: 'var set|"
using assms var_infinite_INNER card_of_Un_singl_ordLess_infinite
unfolding goodEnv_def by fastforce
hence "|{x,y} ∪ {ya. rho ys ya ≠ None}| <o |UNIV :: 'var set|"
using var_infinite_INNER card_of_Un_singl_ordLess_infinite by fastforce
moreover
{have "?Left ⊆ {x,y} ∪ {ya. rho ys ya ≠ None}"
unfolding swapEnvDom_def sw_def[abs_def] by auto
hence "|?Left| ≤o |{x,y} ∪ {ya. rho ys ya ≠ None}|"
using card_of_mono1 by auto
}
ultimately show "|?Left| <o |UNIV :: 'var set|" using ordLeq_ordLess_trans by blast
qed
lemma swapEnvIm_preserves_good:
assumes "goodEnv rho"
shows "goodEnv (swapEnvIm xs x y rho)"
using assms unfolding goodEnv_def swapEnvIm_def liftAll_def
by (auto simp: lift_def split: option.splits)
lemma swapEnv_preserves_good[simp]:
assumes "goodEnv rho"
shows "goodEnv (rho &[x ∧ y]_xs)"
unfolding swapEnv_def comp_def
using assms by(auto simp add: swapEnvDom_preserves_good swapEnvIm_preserves_good)
lemmas swapAll_preserve_good =
swap_preserves_good swapAbs_preserves_good
swapInp_preserves_good swapBinp_preserves_good
swapEnv_preserves_good
lemma psubst_preserves_good[simp]:
assumes "goodEnv rho" and "good X"
shows "good (X #[rho])"
using assms good_imp_qGood_pick goodEnv_imp_qGoodEnv_pickE
qPsubst_preserves_qGood qGood_iff_good_asTerm unfolding psubst_def by fastforce
lemma psubstAbs_preserves_good[simp]:
assumes good_rho: "goodEnv rho" and goodAbs_A: "goodAbs A"
shows "goodAbs (A $[rho])"
using assms goodAbs_A goodAbs_imp_qGoodAbs_pick goodEnv_imp_qGoodEnv_pickE
qPsubstAbs_preserves_qGoodAbs qGoodAbs_iff_goodAbs_asAbs unfolding psubstAbs_def by fastforce
lemma psubstInp_preserves_good[simp]:
assumes good_rho: "goodEnv rho" and good: "goodInp inp"
shows "goodInp (inp %[rho])"
using assms unfolding goodInp_def psubstInp_def liftAll_def
by (auto simp add: lift_def split: option.splits)
lemma psubstBinp_preserves_good[simp]:
assumes good_rho: "goodEnv rho" and good: "goodBinp binp"
shows "goodBinp (binp %%[rho])"
using assms unfolding goodBinp_def psubstBinp_def liftAll_def
by (auto simp add: lift_def split: option.splits)
lemma psubstEnv_preserves_good[simp]:
assumes good: "goodEnv rho" and good': "goodEnv rho'"
shows "goodEnv (rho &[rho'])"
unfolding goodEnv_def liftAll_def
proof safe
fix zs z X'
assume *: "(rho &[rho']) zs z = Some X'"
show "good X'"
proof(cases "rho zs z")
case None
hence "rho' zs z = Some X'" using * unfolding psubstEnv_def by auto
thus ?thesis using good' unfolding goodEnv_def liftAll_def by auto
next
case (Some X)
hence "X' = (X #[rho'])" using * unfolding psubstEnv_def by auto
moreover have "good X" using Some good unfolding goodEnv_def liftAll_def by auto
ultimately show ?thesis using good' psubst_preserves_good by auto
qed
next
fix xs ys let ?Left = "{y. (rho &[rho']) ys y ≠ None}"
let ?Left1 = "{y. rho ys y ≠ None}" let ?Left2 = "{y. rho' ys y ≠ None}"
have "|?Left1| <o |UNIV :: 'var set| ∧ |?Left2| <o |UNIV :: 'var set|"
using good good' unfolding goodEnv_def by simp
hence "|?Left1 ∪ ?Left2| <o |UNIV :: 'var set|"
using var_infinite_INNER card_of_Un_ordLess_infinite by auto
moreover
{have "?Left ⊆ ?Left1 ∪ ?Left2" unfolding psubstEnv_def by auto
hence "|?Left| ≤o |?Left1 ∪ ?Left2|" using card_of_mono1 by auto
}
ultimately show "|?Left| <o |UNIV :: 'var set|" using ordLeq_ordLess_trans by blast
qed
lemmas psubstAll_preserve_good =
psubst_preserves_good psubstAbs_preserves_good
psubstInp_preserves_good psubstBinp_preserves_good
psubstEnv_preserves_good
lemma idEnv_preserves_good[simp]: "goodEnv idEnv"
unfolding goodEnv_def idEnv_def liftAll_def
using var_infinite_INNER finite_ordLess_infinite2 by auto
lemma updEnv_preserves_good[simp]:
assumes good_X: "good X" and good_rho: "goodEnv rho"
shows "goodEnv (rho [x ← X]_xs)"
using assms unfolding updEnv_def goodEnv_def liftAll_def
proof safe
fix ys y Y
assume "good X" and "∀ys y Y. rho ys y = Some Y ⟶ good Y"
and "(if ys = xs ∧ y = x then Some X else rho ys y) = Some Y"
thus "good Y"
by(cases "ys = xs ∧ y = x") auto
next
fix ys
let ?V' = "{y. (if ys = xs ∧ y = x then Some X else rho ys y) ≠ None}"
let ?V = "λ ys. {y. rho ys y ≠ None}"
assume "∀ ys. |?V ys| <o |UNIV :: 'var set|"
hence "|{x} ∪ ?V ys| <o |UNIV :: 'var set|"
using var_infinite_INNER card_of_Un_singl_ordLess_infinite by fastforce
moreover
{have "?V' ⊆ {x} ∪ ?V ys" by auto
hence "|?V'| ≤o |{x} ∪ ?V ys|" using card_of_mono1 by auto
}
ultimately show "|?V'| <o |UNIV :: 'var set|" using ordLeq_ordLess_trans by blast
qed
lemma getEnv_preserves_good[simp]:
assumes "goodEnv rho" and "rho xs x = Some X"
shows "good X"
using assms unfolding goodEnv_def liftAll_def by simp
lemmas envOps_preserve_good =
idEnv_preserves_good updEnv_preserves_good
getEnv_preserves_good
lemma subst_preserves_good[simp]:
assumes "good X" and "good Y"
shows "good (Y #[X / x]_xs)"
unfolding subst_def
using assms by simp
lemma substAbs_preserves_good[simp]:
assumes "good X" and "goodAbs A"
shows "goodAbs (A $[X / x]_xs)"
unfolding substAbs_def
using assms by simp
lemma substInp_preserves_good[simp]:
assumes "good X" and "goodInp inp"
shows "goodInp (inp %[X / x]_xs)"
unfolding substInp_def using assms by simp
lemma substBinp_preserves_good[simp]:
assumes "good X" and "goodBinp binp"
shows "goodBinp (binp %%[X / x]_xs)"
unfolding substBinp_def using assms by simp
lemma substEnv_preserves_good[simp]:
assumes "good X" and "goodEnv rho"
shows "goodEnv (rho &[X / x]_xs)"
unfolding substEnv_def using assms by simp
lemmas substAll_preserve_good =
subst_preserves_good substAbs_preserves_good
substInp_preserves_good substBinp_preserves_good
substEnv_preserves_good
lemma vsubst_preserves_good[simp]:
assumes "good Y"
shows "good (Y #[x1 // x]_xs)"
unfolding vsubst_def using assms by simp
lemma vsubstAbs_preserves_good[simp]:
assumes "goodAbs A"
shows "goodAbs (A $[x1 // x]_xs)"
unfolding vsubstAbs_def using assms by simp
lemma vsubstInp_preserves_good[simp]:
assumes "goodInp inp"
shows "goodInp (inp %[x1 // x]_xs)"
unfolding vsubstInp_def using assms by simp
lemma vsubstBinp_preserves_good[simp]:
assumes "goodBinp binp"
shows "goodBinp (binp %%[x1 // x]_xs)"
unfolding vsubstBinp_def using assms by simp
lemma vsubstEnv_preserves_good[simp]:
assumes "goodEnv rho"
shows "goodEnv (rho &[x1 // x]_xs)"
unfolding vsubstEnv_def using assms by simp
lemmas vsubstAll_preserve_good =
vsubst_preserves_good vsubstAbs_preserves_good
vsubstInp_preserves_good vsubstBinp_preserves_good
vsubstEnv_preserves_good
lemmas all_preserve_good =
Cons_preserve_good
swapAll_preserve_good
psubstAll_preserve_good
envOps_preserve_good
substAll_preserve_good
vsubstAll_preserve_good
subsubsection ‹The syntactic operators are almost constructors›
text‹The only one that does not act precisely like a constructor is ``Abs".›
theorem Var_inj[simp]:
"(((Var xs x)::('index,'bindex,'varSort,'var,'opSym)term) = Var ys y) =
(xs = ys ∧ x = y)"
by (metis alpha_qVar_iff pick_Var_qVar qTerm.inject)
lemma Op_inj[simp]:
assumes "goodInp inp" and "goodBinp binp"
and "goodInp inp'" and "goodBinp binp'"
shows
"(Op delta inp binp = Op delta' inp' binp') =
(delta = delta' ∧ inp = inp' ∧ binp = binp')"
using assms pickInp_alphaInp_iff_equal pickBinp_alphaBinp_iff_equal
goodInp_imp_qGoodInp_pickInp goodBinp_imp_qGoodBinp_pickBinp
unfolding Op_def by (fastforce simp: asTerm_equal_iff_alpha)
text‹``Abs" is almost injective (``ainj"), with almost injectivity expressed
in two ways:
\\- maximally, using "forall" -- this is suitable for elimination of ``Abs" equalities;
\\- minimally, using "exists" -- this is suitable for introduction of ``Abs" equalities.
›
lemma Abs_ainj_all:
assumes good: "good X" and good': "good X'"
shows
"(Abs xs x X = Abs xs' x' X') =
(xs = xs' ∧
(∀ y. (y = x ∨ fresh xs y X) ∧ (y = x' ∨ fresh xs y X') ⟶
(X #[y ∧ x]_xs) = (X' #[y ∧ x']_xs)))"
proof-
let ?qX = "pick X" let ?qX' = "pick X'"
have qgood: "qGood ?qX ∧ qGood ?qX'" using good good' good_imp_qGood_pick by auto
hence qgood_qXyx: "∀ y. qGood (?qX #[[y ∧ x]]_xs)"
using qSwap_preserves_qGood by auto
have "qGoodAbs(qAbs xs x ?qX)" using qgood by simp
hence "(Abs xs x X = Abs xs' x' X') = (qAbs xs x ?qX $= qAbs xs' x' ?qX')"
unfolding Abs_def by (auto simp add: asAbs_equal_iff_alphaAbs)
also
have "… = (xs = xs' ∧
(∀ y. (y = x ∨ qFresh xs y ?qX) ∧ (y = x' ∨ qFresh xs y ?qX') ⟶
(?qX #[[y ∧ x]]_xs) #= (?qX' #[[y ∧ x']]_xs)))"
using qgood alphaAbs_qAbs_iff_all_equal_or_qFresh[of ?qX ?qX'] by blast
also
have "… = (xs = xs' ∧
(∀ y. (y = x ∨ fresh xs y X) ∧ (y = x' ∨ fresh xs y X') ⟶
(X #[y ∧ x]_xs) = (X' #[y ∧ x']_xs)))"
unfolding fresh_def swap_def using qgood_qXyx by (auto simp add: asTerm_equal_iff_alpha)
finally show ?thesis .
qed
lemma Abs_ainj_ex:
assumes good: "good X" and good': "good X'"
shows
"(Abs xs x X = Abs xs' x' X') =
(xs = xs' ∧
(∃ y. y ∉ {x,x'} ∧ fresh xs y X ∧ fresh xs y X' ∧
(X #[y ∧ x]_xs) = (X' #[y ∧ x']_xs)))"
proof-
let ?qX = "pick X" let ?qX' = "pick X'"
have qgood: "qGood ?qX ∧ qGood ?qX'" using good good' good_imp_qGood_pick by auto
hence qgood_qXyx: "∀ y. qGood (?qX #[[y ∧ x]]_xs)"
using qSwap_preserves_qGood by auto
have "qGoodAbs(qAbs xs x ?qX)" using qgood by simp
hence "(Abs xs x X = Abs xs' x' X') = (qAbs xs x ?qX $= qAbs xs' x' ?qX')"
unfolding Abs_def by (auto simp add: asAbs_equal_iff_alphaAbs)
also
have "… = (xs = xs' ∧
(∃ y. y ∉ {x,x'} ∧ qFresh xs y ?qX ∧ qFresh xs y ?qX' ∧
(?qX #[[y ∧ x]]_xs) #= (?qX' #[[y ∧ x']]_xs)))"
using qgood alphaAbs_qAbs_iff_ex_distinct_qFresh[of ?qX xs x xs' x' ?qX'] by blast
also
have "… = (xs = xs' ∧
(∃ y. y ∉ {x,x'} ∧ fresh xs y X ∧ fresh xs y X' ∧
(X #[y ∧ x]_xs) = (X' #[y ∧ x']_xs)))"
unfolding fresh_def swap_def using qgood_qXyx asTerm_equal_iff_alpha by auto
finally show ?thesis .
qed
lemma Abs_cong[fundef_cong]:
assumes good: "good X" and good': "good X'"
and y: "fresh xs y X" and y': "fresh xs y X'"
and eq: "(X #[y ∧ x]_xs) = (X' #[y ∧ x']_xs)"
shows "Abs xs x X = Abs xs x' X'"
proof-
let ?qX = "pick X" let ?qX' = "pick X'"
have qgood: "qGood ?qX ∧ qGood ?qX'" using good good' good_imp_qGood_pick by auto
hence qgood_qXyx: "∀ y. qGood (?qX #[[y ∧ x]]_xs)"
using qSwap_preserves_qGood by auto
have qEq: "(?qX #[[y ∧ x]]_xs) #= (?qX' #[[y ∧ x']]_xs)"
using eq unfolding fresh_def swap_def
using qgood_qXyx asTerm_equal_iff_alpha by auto
have "(qAbs xs x ?qX $= qAbs xs x' ?qX')"
apply(rule alphaAbs_ex_equal_or_qFresh_imp_alphaAbs_qAbs)
using qgood apply simp
unfolding alphaAbs_ex_equal_or_qFresh_def using y y' qEq
unfolding fresh_def by auto
moreover have "qGoodAbs(qAbs xs x ?qX)" using qgood by simp
ultimately show "Abs xs x X = Abs xs x' X'"
unfolding Abs_def by (auto simp add: asAbs_equal_iff_alphaAbs)
qed
lemma Abs_swap_fresh:
assumes good_X: "good X" and fresh: "fresh xs x' X"
shows "Abs xs x X = Abs xs x' (X #[x' ∧ x]_xs)"
proof-
let ?x'x = "swap xs x' x" let ?qx'x = "qSwap xs x' x"
have good_pickX: "qGood (pick X)" using good_X good_imp_qGood_pick by auto
hence good_qAbs_pickX: "qGoodAbs (qAbs xs x (pick X))" by simp
have good_x'x_pickX: "qGood (?qx'x (pick X))"
using good_pickX qSwap_preserves_qGood by auto
have "Abs xs x X = asAbs (qAbs xs x (pick X))" unfolding Abs_def by simp
also
{have "qAbs xs x (pick X) $= qAbs xs x' (?qx'x (pick X))"
using good_pickX fresh unfolding fresh_def using qAbs_alphaAbs_qSwap_qFresh by fastforce
moreover
{have "?qx'x (pick X) #= pick (?x'x X)"
using good_X by (auto simp add: pick_swap_qSwap alpha_sym)
hence "qAbs xs x' (?qx'x (pick X)) $= qAbs xs x' (pick (?x'x X))"
using good_x'x_pickX qAbs_preserves_alpha by fastforce
}
ultimately have "qAbs xs x (pick X) $= qAbs xs x' (pick (?x'x X))"
using good_qAbs_pickX alphaAbs_trans by blast
hence "asAbs (qAbs xs x (pick X)) = asAbs (qAbs xs x' (pick (?x'x X)))"
using good_qAbs_pickX by (auto simp add: asAbs_equal_iff_alphaAbs)
}
also have "asAbs (qAbs xs x' (pick (?x'x X))) = Abs xs x' (?x'x X)"
unfolding Abs_def by auto
finally show ?thesis .
qed
lemma Var_diff_Op[simp]:
"Var xs x ≠ Op delta inp binp"
by (simp add: Op_def Var_def asTerm_equal_iff_alpha)
lemma Op_diff_Var[simp]:
"Op delta inp binp ≠ Var xs x"
using Var_diff_Op[of _ _ _ inp] by blast
theorem term_nchotomy:
assumes "good X"
shows
"(∃ xs x. X = Var xs x) ∨
(∃ delta inp binp. goodInp inp ∧ goodBinp binp ∧ X = Op delta inp binp)"
proof-
let ?qX = "pick X"
have good_qX: "qGood ?qX" using assms good_imp_qGood_pick by auto
have X: "X = asTerm ?qX" using assms asTerm_pick by auto
show ?thesis
proof(cases "?qX")
fix xs x assume Case1: "?qX = qVar xs x"
have "X = Var xs x" unfolding Var_def using X Case1 by simp
thus ?thesis by blast
next
fix delta qinp qbinp assume Case2: "?qX = qOp delta qinp qbinp"
hence good_qinp: "qGoodInp qinp ∧ qGoodBinp qbinp" using good_qX by simp
let ?inp = "asInp qinp" let ?binp = "asBinp qbinp"
have "qinp %= pickInp ?inp ∧ qbinp %%= pickBinp ?binp"
using good_qinp pickInp_asInp alphaInp_sym pickBinp_asBinp alphaBinp_sym by blast
hence "qOp delta qinp qbinp #= qOp delta (pickInp ?inp) (pickBinp ?binp)" by simp
hence "asTerm (qOp delta qinp qbinp) = Op delta ?inp ?binp"
unfolding Op_def using Case2 good_qX by (auto simp add: asTerm_equal_iff_alpha)
hence "X = Op delta ?inp ?binp" using X Case2 by auto
moreover have "goodInp ?inp ∧ goodBinp ?binp"
using good_qinp qGoodInp_iff_goodInp_asInp qGoodBinp_iff_goodBinp_asBinp by auto
ultimately show ?thesis by blast
qed
qed
theorem abs_nchotomy:
assumes "goodAbs A"
shows "∃ xs x X. good X ∧ A = Abs xs x X"
by (metis Abs_asTerm_asAbs_qAbs asAbs_pick assms
goodAbs_imp_qGoodAbs_pick qGoodAbs.elims(2) qGood_iff_good_asTerm)
lemmas good_freeCons =
Op_inj Var_diff_Op Op_diff_Var
subsection ‹Properties lifted from quasi-terms to terms›
subsubsection ‹Simplification rules›
theorem swap_Var_simp[simp]:
"((Var xs x) #[y1 ∧ y2]_ys) = Var xs (x @xs[y1 ∧ y2]_ys)"
by (metis QuasiTerms_Swap_Fresh.qSwapAll_simps(1) Var_def asTerm_qSwap_swap qItem_simps(9))
lemma swap_Op_simp[simp]:
assumes "goodInp inp" "goodBinp binp"
shows "((Op delta inp binp) #[x1 ∧ x2]_xs) =
Op delta (inp %[x1 ∧ x2]_xs) (binp %%[x1 ∧ x2]_xs)"
by (metis Op_asInp_asTerm_qOp Op_def asTerm_qSwap_swap assms(1) assms(2) goodBinp_imp_qGoodBinp_pickBinp goodInp_imp_qGoodInp_pickInp qGood_qGoodInp qSwapBinp_preserves_qGoodBinp
qSwapInp_preserves_qGoodInp qSwap_qSwapInp swapBinp_def2 swapInp_def2)
lemma swapAbs_simp[simp]:
assumes "good X"
shows "((Abs xs x X) $[y1 ∧ y2]_ys) = Abs xs (x @xs[y1 ∧ y2]_ys) (X #[y1 ∧ y2]_ys)"
by (metis Abs_asTerm_asAbs_qAbs Abs_preserves_good alphaAbs_preserves_qGoodAbs2 asAbs_qSwapAbs_swapAbs assms goodAbs_imp_qGoodAbs_pick good_imp_qGood_pick local.Abs_def
local.swap_def qAbs_pick_Abs qSwapAbs.simps qSwap_preserves_qGood1)
lemmas good_swapAll_simps =
swap_Op_simp swapAbs_simp
theorem fresh_Var_simp[simp]:
"fresh ys y (Var xs x :: ('index,'bindex,'varSort,'var,'opSym)term) ⟷
(ys ≠ xs ∨ y ≠ x)"
by (simp add: Var_def fresh_asTerm_qFresh)
lemma fresh_Op_simp[simp]:
assumes "goodInp inp" "goodBinp binp"
shows
"fresh xs x (Op delta inp binp) ⟷
(freshInp xs x inp ∧ freshBinp xs x binp)"
by (metis Op_def Op_preserves_good assms(1) assms(2) freshBinp_def2
freshInp_def2 fresh_asTerm_qFresh qFresh_qFreshInp qGood_iff_good_asTerm)
lemma freshAbs_simp[simp]:
assumes "good X"
shows "freshAbs ys y (Abs xs x X) ⟷ (ys = xs ∧ y = x ∨ fresh ys y X)"
proof-
let ?fr = "fresh ys y" let ?qfr = "qFresh ys y"
let ?frA = "freshAbs ys y" let ?qfrA = "qFreshAbs ys y"
have "qGood (pick X)" using assms by(auto simp add: good_imp_qGood_pick)
hence good_qAbs_pick_X: "qGoodAbs (qAbs xs x (pick X))"
using assms good_imp_qGood_pick by auto
have "?frA (Abs xs x X) = ?qfrA ((pick o asAbs) (qAbs xs x (pick X)))"
unfolding freshAbs_def Abs_def by simp
also
{have "(pick o asAbs) (qAbs xs x (pick X)) $= qAbs xs x (pick X)"
using good_qAbs_pick_X pick_asAbs by fastforce
hence "?qfrA ((pick o asAbs) (qAbs xs x (pick X))) = ?qfrA (qAbs xs x (pick X))"
using good_qAbs_pick_X qFreshAbs_preserves_alphaAbs by blast
}
also have "?qfrA(qAbs xs x (pick X)) = (ys = xs ∧ y = x ∨ ?qfr (pick X))" by simp
also have "… = (ys = xs ∧ y = x ∨ ?fr X)" unfolding fresh_def by simp
finally show ?thesis .
qed
lemmas good_freshAll_simps =
fresh_Op_simp freshAbs_simp
theorem skel_Var_simp[simp]:
"skel (Var xs x) = Branch Map.empty Map.empty"
by (metis alpha_qSkel pick_Var_qVar qSkel.simps(1) skel_def)
lemma skel_Op_simp[simp]:
assumes "goodInp inp" and "goodBinp binp"
shows "skel (Op delta inp binp) = Branch (skelInp inp) (skelBinp binp)"
by (metis (no_types, lifting) alpha_qSkel assms
qOp_pickInp_pick_Op qSkel_qSkelInp skelBinp_def skelInp_def skel_def)
lemma skelAbs_simp[simp]:
assumes "good X"
shows "skelAbs (Abs xs x X) = Branch (λi. Some (skel X)) Map.empty"
by (metis alphaAll_qSkelAll assms qAbs_pick_Abs qSkelAbs.simps skelAbs_def skel_def)
lemmas good_skelAll_simps =
skel_Op_simp skelAbs_simp
lemma psubst_Var:
assumes "goodEnv rho"
shows "((Var xs x) #[rho]) =
(case rho xs x of None ⇒ Var xs x
|Some X ⇒ X)"
proof-
let ?X = "Var xs x" let ?qX = "qVar xs x"
let ?qrho = "pickE rho"
have good_qX: "qGood ?qX" using assms by simp
moreover have good_qrho: "qGoodEnv ?qrho" using assms goodEnv_imp_qGoodEnv_pickE by auto
ultimately have good_qXrho: "qGood (?qX #[[?qrho]])"
using assms qPsubst_preserves_qGood by(auto simp del: qGoodAll_simps qPsubst.simps)
have "(?X #[rho]) = asTerm ((pick (asTerm ?qX)) #[[?qrho]])"
unfolding Var_def psubst_def by simp
also
{have "?qX #= pick (asTerm ?qX)" using good_qX pick_asTerm alpha_sym by fastforce
hence "(?qX #[[?qrho]]) #= ((pick (asTerm ?qX)) #[[?qrho]])"
using good_qrho good_qX qPsubst_preserves_alpha1[of _ ?qX] by fastforce
hence "asTerm ((pick (asTerm ?qX)) #[[?qrho]]) = asTerm (?qX #[[?qrho]])"
using good_qXrho asTerm_equal_iff_alpha[of "?qX #[[?qrho]]"] by blast
}
also have "asTerm (?qX #[[?qrho]]) =
asTerm (case ?qrho xs x of None ⇒ qVar xs x
|Some qY ⇒ qY)" unfolding Var_def by simp
finally have 1: "(?X #[rho]) = asTerm (case ?qrho xs x of None ⇒ qVar xs x
|Some qY ⇒ qY)" .
show ?thesis
proof(cases "rho xs x")
assume Case1: "rho xs x = None"
hence "?qrho xs x = None" unfolding pickE_def lift_def by simp
thus ?thesis using 1 Case1 unfolding Var_def by simp
next
fix X assume Case2: "rho xs x = Some X"
hence "good X" using assms unfolding goodEnv_def liftAll_def by auto
hence "asTerm (pick X) = X" using asTerm_pick by auto
moreover have qrho: "?qrho xs x = Some (pick X)"
using Case2 unfolding pickE_def lift_def by simp
ultimately show ?thesis using 1 Case2 unfolding Var_def by simp
qed
qed
corollary psubst_Var_simp1[simp]:
assumes "goodEnv rho" and "rho xs x = None"
shows "((Var xs x) #[rho]) = Var xs x"
using assms by(simp add: psubst_Var)
corollary psubst_Var_simp2[simp]:
assumes "goodEnv rho" and "rho xs x = Some X"
shows "((Var xs x) #[rho]) = X"
using assms by(simp add: psubst_Var)
lemma psubst_Op_simp[simp]:
assumes good_inp: "goodInp inp" "goodBinp binp"
and good_rho: "goodEnv rho"
shows
"((Op delta inp binp) #[rho]) = Op delta (inp %[rho]) (binp %%[rho])"
proof-
let ?qrho = "pickE rho"
let ?sbs = "psubst rho" let ?qsbs = "qPsubst ?qrho"
let ?sbsI = "psubstInp rho" let ?qsbsI = "qPsubstInp ?qrho"
let ?sbsB = "psubstBinp rho" let ?qsbsB = "qPsubstBinp ?qrho"
let ?op = "Op delta" let ?qop = "qOp delta"
have good_qop_pickInp_inp: "qGood (?qop (pickInp inp) (pickBinp binp))"
using good_inp goodInp_imp_qGoodInp_pickInp
goodBinp_imp_qGoodBinp_pickBinp by auto
hence "qGood ((pick o asTerm) (?qop (pickInp inp) (pickBinp binp)))"
using good_imp_qGood_pick qGood_iff_good_asTerm by fastforce
moreover have good_qrho: "qGoodEnv ?qrho"
using good_rho goodEnv_imp_qGoodEnv_pickE by auto
ultimately have good: "qGood (?qsbs((pick o asTerm) (?qop (pickInp inp) (pickBinp binp))))"
using qPsubst_preserves_qGood by auto
have "?sbs (?op inp binp) =
asTerm (?qsbs ((pick o asTerm) (?qop (pickInp inp) (pickBinp binp))))"
unfolding psubst_def Op_def by simp
also
{have "(pick o asTerm) (?qop (pickInp inp) (pickBinp binp)) #=
?qop (pickInp inp) (pickBinp binp)"
using good_qop_pickInp_inp pick_asTerm by fastforce
hence "?qsbs((pick o asTerm) (?qop (pickInp inp) (pickBinp binp))) #=
?qsbs(?qop (pickInp inp) (pickBinp binp))"
using good_qop_pickInp_inp good_qrho qPsubst_preserves_alpha1 by fastforce
moreover have "?qsbs (?qop (pickInp inp) (pickBinp binp)) =
?qop (?qsbsI (pickInp inp)) (?qsbsB (pickBinp binp))" by simp
moreover
{have "?qsbsI (pickInp inp) %= pickInp (?sbsI inp) ∧
?qsbsB (pickBinp binp) %%= pickBinp (?sbsB binp)"
using good_rho good_inp pickInp_psubstInp_qPsubstInp[of inp rho]
pickBinp_psubstBinp_qPsubstBinp[of binp rho] alphaInp_sym alphaBinp_sym by auto
hence "?qop (?qsbsI (pickInp inp)) (?qsbsB (pickBinp binp)) #=
?qop (pickInp (?sbsI inp)) (pickBinp (?sbsB binp))" by simp
}
ultimately have "?qsbs((pick o asTerm) (?qop (pickInp inp) (pickBinp binp))) #=
?qop (pickInp (?sbsI inp)) (pickBinp (?sbsB binp))"
using good alpha_trans by force
hence "asTerm (?qsbs((pick o asTerm) (?qop (pickInp inp) (pickBinp binp)))) =
asTerm (?qop (pickInp (?sbsI inp)) (pickBinp (?sbsB binp)))"
using good by (auto simp add: asTerm_equal_iff_alpha)
}
also have "asTerm (?qop (pickInp (?sbsI inp)) (pickBinp (?sbsB binp))) =
?op (?sbsI inp) (?sbsB binp)" unfolding Op_def by simp
finally show ?thesis .
qed
lemma psubstAbs_simp[simp]:
assumes good_X: "good X" and good_rho: "goodEnv rho" and
x_fresh_rho: "freshEnv xs x rho"
shows "((Abs xs x X) $[rho]) = Abs xs x (X #[rho])"
proof-
let ?qrho = "pickE rho"
let ?sbs = "psubst rho" let ?qsbs = "qPsubst ?qrho"
let ?sbsA = "psubstAbs rho" let ?qsbsA = "qPsubstAbs ?qrho"
have good_qrho: "qGoodEnv ?qrho"
using good_rho goodEnv_imp_qGoodEnv_pickE by auto
have good_pick_X: "qGood (pick X)" using good_X good_imp_qGood_pick by auto
hence good_qsbs_pick_X: "qGood(?qsbs (pick X))"
using good_qrho qPsubst_preserves_qGood by auto
have good_qAbs_pick_X: "qGoodAbs (qAbs xs x (pick X))"
using good_X good_imp_qGood_pick by auto
hence "qGoodAbs ((pick o asAbs) (qAbs xs x (pick X)))"
using goodAbs_imp_qGoodAbs_pick qGoodAbs_iff_goodAbs_asAbs by fastforce
hence good: "qGoodAbs (?qsbsA ((pick o asAbs) (qAbs xs x (pick X))))"
using good_qrho qPsubstAbs_preserves_qGoodAbs by auto
have x_fresh_qrho: "qFreshEnv xs x ?qrho"
using x_fresh_rho unfolding freshEnv_def2 by auto
have "?sbsA (Abs xs x X) = asAbs (?qsbsA ((pick o asAbs) (qAbs xs x (pick X))))"
unfolding psubstAbs_def Abs_def by simp
also
{have "(pick o asAbs) (qAbs xs x (pick X)) $= qAbs xs x (pick X)"
using good_qAbs_pick_X pick_asAbs by fastforce
hence "?qsbsA((pick o asAbs) (qAbs xs x (pick X))) $= ?qsbsA(qAbs xs x (pick X))"
using good_qAbs_pick_X good_qrho qPsubstAbs_preserves_alphaAbs1 by force
moreover have "?qsbsA(qAbs xs x (pick X)) $= qAbs xs x (?qsbs (pick X))"
using qFresh_qPsubst_commute_qAbs good_pick_X good_qrho x_fresh_qrho by auto
moreover
{have "?qsbs (pick X) #= pick (?sbs X)"
using good_rho good_X pick_psubst_qPsubst alpha_sym by fastforce
hence "qAbs xs x (?qsbs (pick X)) $= qAbs xs x (pick (?sbs X))"
using good_qsbs_pick_X qAbs_preserves_alpha by fastforce
}
ultimately
have "?qsbsA((pick o asAbs) (qAbs xs x (pick X))) $= qAbs xs x (pick (?sbs X))"
using good alphaAbs_trans by blast
hence "asAbs (?qsbsA((pick o asAbs) (qAbs xs x (pick X)))) =
asAbs (qAbs xs x (pick (?sbs X)))"
using good asAbs_equal_iff_alphaAbs by auto
}
also have "asAbs (qAbs xs x (pick (?sbs X))) = Abs xs x (?sbs X)"
unfolding Abs_def by simp
finally show ?thesis .
qed
lemmas good_psubstAll_simps =
psubst_Var_simp1 psubst_Var_simp2
psubst_Op_simp psubstAbs_simp
theorem getEnv_idEnv[simp]: "idEnv xs x = None"
unfolding idEnv_def by simp
lemma getEnv_updEnv[simp]:
"(rho [x ← X]_xs) ys y = (if ys = xs ∧ y = x then Some X else rho ys y)"
unfolding updEnv_def by auto
theorem getEnv_updEnv1:
"ys ≠ xs ∨ y ≠ x ⟹ (rho [x ← X]_xs) ys y = rho ys y"
by auto
theorem getEnv_updEnv2:
"(rho [x ← X]_xs) xs x = Some X"
by auto
lemma subst_Var_simp1[simp]:
assumes "good Y"
and "ys ≠ xs ∨ y ≠ x"
shows "((Var xs x) #[Y / y]_ys) = Var xs x"
using assms unfolding subst_def by auto
lemma subst_Var_simp2[simp]:
assumes "good Y"
shows "((Var xs x) #[Y / x]_xs) = Y"
using assms unfolding subst_def by auto
lemma subst_Op_simp[simp]:
assumes "good Y"
and "goodInp inp" and "goodBinp binp"
shows
"((Op delta inp binp) #[Y / y]_ys) =
Op delta (inp %[Y / y]_ys) (binp %%[Y / y]_ys)"
using assms unfolding subst_def substInp_def substBinp_def by auto
lemma substAbs_simp[simp]:
assumes good: "good Y" and good_X: "good X" and
x_dif_y: "xs ≠ ys ∨ x ≠ y" and x_fresh: "fresh xs x Y"
shows "((Abs xs x X) $[Y / y]_ys) = Abs xs x (X #[Y / y]_ys)"
proof-
have "freshEnv xs x (idEnv [y ← Y]_ys)" unfolding freshEnv_def liftAll_def
using x_dif_y x_fresh by auto
thus ?thesis using assms unfolding subst_def substAbs_def by auto
qed
lemmas good_substAll_simps =
subst_Var_simp1 subst_Var_simp2
subst_Op_simp substAbs_simp
theorem vsubst_Var_simp[simp]:
"((Var xs x) #[y1 // y]_ys) = Var xs (x @xs[y1 / y]_ys)"
unfolding vsubst_def
apply(case_tac "ys = xs ∧ y = x") by simp_all
lemma vsubst_Op_simp[simp]:
assumes "goodInp inp" and "goodBinp binp"
shows
"((Op delta inp binp) #[y1 // y]_ys) =
Op delta (inp %[y1 // y]_ys) (binp %%[y1 // y]_ys)"
using assms unfolding vsubst_def vsubstInp_def vsubstBinp_def by auto
lemma vsubstAbs_simp[simp]:
assumes "good X" and
"xs ≠ ys ∨ x ∉ {y,y1}"
shows "((Abs xs x X) $[y1 // y]_ys) = Abs xs x (X #[y1 // y]_ys)"
using assms unfolding vsubst_def vsubstAbs_def by auto
lemmas good_vsubstAll_simps =
vsubst_Op_simp vsubstAbs_simp
lemmas good_allOpers_simps =
good_swapAll_simps
good_freshAll_simps
good_skelAll_simps
good_psubstAll_simps
good_substAll_simps
good_vsubstAll_simps
subsubsection ‹The ability to pick fresh variables›
lemma single_non_fresh_ordLess_var:
"good X ⟹ |{x. ¬ fresh xs x X}| <o |UNIV :: 'var set|"
unfolding fresh_def
by(auto simp add: good_imp_qGood_pick single_non_qFresh_ordLess_var)
lemma single_non_freshAbs_ordLess_var:
"goodAbs A ⟹ |{x. ¬ freshAbs xs x A}| <o |UNIV :: 'var set|"
unfolding freshAbs_def
by(auto simp add: goodAbs_imp_qGoodAbs_pick single_non_qFreshAbs_ordLess_var)
lemma obtain_fresh1:
fixes XS::"('index,'bindex,'varSort,'var,'opSym)term set" and
Rho::"('index,'bindex,'varSort,'var,'opSym)env set" and rho
assumes Vvar: "|V| <o |UNIV :: 'var set| ∨ finite V" and XSvar: "|XS| <o |UNIV :: 'var set| ∨ finite XS" and
good: "∀ X ∈ XS. good X" and
Rhovar: "|Rho| <o |UNIV :: 'var set| ∨ finite Rho" and RhoGood: "∀ rho ∈ Rho. goodEnv rho"
shows
"∃ z. z ∉ V ∧
(∀ X ∈ XS. fresh xs z X) ∧
(∀ rho ∈ Rho. freshEnv xs z rho)"
proof-
let ?qXS = "pick ` XS" let ?qRho = "pickE ` Rho"
have "|?qXS| ≤o |XS|" using card_of_image by auto
hence 1: "|?qXS| <o |UNIV :: 'var set| ∨ finite ?qXS"
using ordLeq_ordLess_trans card_of_ordLeq_finite XSvar by blast
have "|?qRho| ≤o |Rho|" using card_of_image by auto
hence 2: "|?qRho| <o |UNIV :: 'var set| ∨ finite ?qRho"
using ordLeq_ordLess_trans card_of_ordLeq_finite Rhovar by blast
have 3: "∀ qX ∈ ?qXS. qGood qX" using good good_imp_qGood_pick by auto
have "∀ qrho ∈ ?qRho. qGoodEnv qrho" using RhoGood goodEnv_imp_qGoodEnv_pickE by auto
then obtain z where
"z ∉ V ∧ (∀ qX ∈ ?qXS. qFresh xs z qX) ∧
(∀ qrho ∈ ?qRho. qFreshEnv xs z qrho)"
using Vvar 1 2 3 obtain_qFreshEnv[of V ?qXS ?qRho] by fastforce
thus ?thesis unfolding fresh_def freshEnv_def2 by auto
qed
lemma obtain_fresh:
fixes V::"'var set" and
XS::"('index,'bindex,'varSort,'var,'opSym)term set" and
AS::"('index,'bindex,'varSort,'var,'opSym)abs set" and
Rho::"('index,'bindex,'varSort,'var,'opSym)env set"
assumes Vvar: "|V| <o |UNIV :: 'var set| ∨ finite V" and
XSvar: "|XS| <o |UNIV :: 'var set| ∨ finite XS" and
ASvar: "|AS| <o |UNIV :: 'var set| ∨ finite AS" and
Rhovar: "|Rho| <o |UNIV :: 'var set| ∨ finite Rho" and
good: "∀ X ∈ XS. good X" and
ASGood: "∀ A ∈ AS. goodAbs A" and
RhoGood: "∀ rho ∈ Rho. goodEnv rho"
shows
"∃ z. z ∉ V ∧
(∀ X ∈ XS. fresh xs z X) ∧
(∀ A ∈ AS. freshAbs xs z A) ∧
(∀ rho ∈ Rho. freshEnv xs z rho)"
proof-
have XS: "|XS| <o |UNIV :: 'var set|" and AS: "|AS| <o |UNIV :: 'var set|"
using XSvar ASvar finite_ordLess_var by auto
let ?phi = "% A Y. (good Y ∧ (EX ys y. A = Abs ys y Y))"
{fix A assume "A ∈ AS"
hence "goodAbs A" using ASGood by simp
hence "EX Y. ?phi A Y" using abs_nchotomy[of A] by auto
}
then obtain f where 1: "ALL A : AS. ?phi A (f A)"
using bchoice[of AS ?phi] by auto
let ?YS = "f ` AS"
have 2: "ALL Y : ?YS. good Y" using 1 by simp
have "|?YS| <=o |AS|" using card_of_image by auto
hence "|?YS| <o |UNIV :: 'var set|"
using AS ordLeq_ordLess_trans by blast
hence "|XS Un ?YS| <o |UNIV :: 'var set|"
using XS by (auto simp add: var_infinite_INNER card_of_Un_ordLess_infinite)
then obtain z where z: "z ∉ V"
and XSYS: "∀ X ∈ XS Un ?YS. fresh xs z X"
and Rho: "∀ rho ∈ Rho. freshEnv xs z rho"
using Vvar Rhovar good 2 RhoGood
obtain_fresh1[of V "XS Un ?YS" Rho xs] by blast
moreover
{fix A
obtain Y where Y_def: "Y = f A" by blast
assume "A : AS"
hence "fresh xs z Y" unfolding Y_def using XSYS by simp
moreover obtain ys y where Y: "good Y" and A: "A = Abs ys y Y"
unfolding Y_def using ‹A : AS› 1 by auto
ultimately have "freshAbs xs z A" unfolding A using z by auto
}
ultimately show ?thesis by auto
qed
subsubsection ‹Compositionality›
lemma swap_ident[simp]:
assumes "good X"
shows "(X #[x ∧ x]_xs) = X"
using assms asTerm_pick qSwap_ident unfolding swap_def by auto
lemma swap_compose:
assumes good_X: "good X"
shows "((X #[x ∧ y]_zs) #[x' ∧ y']_zs') =
((X #[x' ∧ y']_zs') #[(x @zs[x' ∧ y']_zs') ∧ (y @zs[x' ∧ y']_zs')]_zs)"
using assms qSwap_compose[of _ _ _ _ _ _ "pick X"] by(auto simp add: double_swap_qSwap)
lemma swap_commute:
"⟦good X; zs ≠ zs' ∨ {x,y} ∩ {x',y'} = {}⟧ ⟹
((X #[x ∧ y]_zs) #[x' ∧ y']_zs') = ((X #[x' ∧ y']_zs') #[x ∧ y]_zs)"
using swap_compose[of X zs' x' y' zs x y] by(auto simp add: sw_def)
lemma swap_involutive[simp]:
assumes good_X: "good X"
shows "((X #[x ∧ y]_zs) #[x ∧ y]_zs) = X"
using assms asTerm_pick[of X] by (auto simp add: double_swap_qSwap)
theorem swap_sym: "(X #[x ∧ y]_zs) = (X #[y ∧ x]_zs)"
unfolding swap_def by(auto simp add: qSwap_sym)
lemma swap_involutive2[simp]:
assumes "good X"
shows "((X #[x ∧ y]_zs) #[y ∧ x]_zs) = X"
using assms by(simp add: swap_sym)
lemma swap_preserves_fresh[simp]:
assumes "good X"
shows "fresh xs (x @xs[y1 ∧ y2]_ys) (X #[y1 ∧ y2]_ys) = fresh xs x X"
unfolding fresh_def[of _ _ X] using assms qSwap_preserves_qFresh[of _ _ _ _ _ "pick X"]
by(auto simp add: fresh_swap_qFresh_qSwap)
lemma swap_preserves_fresh_distinct:
assumes "good X" and
"xs ≠ ys ∨ x ∉ {y1,y2}"
shows "fresh xs x (X #[y1 ∧ y2]_ys) = fresh xs x X"
unfolding fresh_def[of _ _ X] using assms
by(auto simp: fresh_swap_qFresh_qSwap qSwap_preserves_qFresh_distinct)
lemma fresh_swap_exchange1:
assumes "good X"
shows "fresh xs x2 (X #[x1 ∧ x2]_xs) = fresh xs x1 X"
unfolding fresh_def[of _ _ X]
using assms by(auto simp: fresh_swap_qFresh_qSwap qFresh_qSwap_exchange1)
lemma fresh_swap_exchange2:
assumes "good X" and "{x1,x2} ⊆ var xs"
shows "fresh xs x2 (X #[x2 ∧ x1]_xs) = fresh xs x1 X"
using assms by(simp add: fresh_swap_exchange1 swap_sym)
lemma fresh_swap_id[simp]:
assumes "good X" and "fresh xs x1 X" "fresh xs x2 X"
shows "(X #[x1 ∧ x2]_xs) = X"
by (metis (no_types, lifting) assms alpha_imp_asTerm_equal alpha_qFresh_qSwap_id asTerm_pick
fresh_def good_imp_qGood_pick local.swap_def qSwap_preserves_qGood1)
lemma freshAbs_swapAbs_id[simp]:
assumes "goodAbs A" "freshAbs xs x1 A" "freshAbs xs x2 A"
shows "(A $[x1 ∧ x2]_xs) = A"
using assms
by (meson alphaAbs_qFreshAbs_qSwapAbs_id alphaAll_trans freshAbs_def goodAbs_imp_qGoodAbs_pick
pick_alphaAbs_iff_equal pick_swapAbs_qSwapAbs swapAbs_preserves_good)
lemma fresh_swap_compose:
assumes "good X" "fresh xs y X" "fresh xs z X"
shows "((X #[y ∧ x]_xs) #[z ∧ y]_xs) = (X #[z ∧ x]_xs)"
using assms by (simp add: sw_def swap_compose)
lemma skel_swap:
assumes "good X"
shows "skel (X #[x1 ∧ x2]_xs) = skel X"
using assms by (metis alpha_qSkel pick_swap_qSwap qSkel_qSwap skel_def)
subsubsection ‹Compositionality for environments›
lemma swapEnv_ident[simp]:
assumes "goodEnv rho"
shows "(rho &[x ∧ x]_xs) = rho"
using assms unfolding swapEnv_defs lift_def
by (intro ext) (auto simp: option.case_eq_if)
lemma swapEnv_compose:
assumes good: "goodEnv rho"
shows "((rho &[x ∧ y]_zs) &[x' ∧ y']_zs') =
((rho &[x' ∧ y']_zs') &[(x @zs[x' ∧ y']_zs') ∧ (y @zs[x' ∧ y']_zs')]_zs)"
proof(rule ext)+
let ?xsw = "x @zs[x' ∧ y']_zs'" let ?ysw = "y @zs[x' ∧ y']_zs'"
let ?xswsw = "?xsw @zs[x' ∧ y']_zs'" let ?yswsw = "?ysw @zs[x' ∧ y']_zs'"
let ?rhosw1 = "rho &[x ∧ y]_zs" let ?rhosw11 = "?rhosw1 &[x' ∧ y']_zs'"
let ?rhosw2 = "rho &[x' ∧ y']_zs'" let ?rhosw22 = "?rhosw2 &[?xsw ∧ ?ysw]_zs"
let ?Sw1 = "λX. (X #[x ∧ y]_zs)" let ?Sw11 = "λX. ((?Sw1 X) #[x' ∧ y']_zs')"
let ?Sw2 = "λX. (X #[x' ∧ y']_zs')" let ?Sw22 = "λX. ((?Sw2 X) #[?xsw ∧ ?ysw]_zs)"
fix us u
let ?usw1 = "u @us [x' ∧ y']_zs'" let ?usw11 = "?usw1 @us [x ∧ y]_zs"
let ?usw2 = "u @us [?xsw ∧ ?ysw]_zs" let ?usw22 = "?usw2 @us [x' ∧ y']_zs'"
have "(?xsw @zs[x' ∧ y']_zs') = x" and "(?ysw @zs[x' ∧ y']_zs') = y" by auto
have "?usw22 = (?usw1 @us[?xswsw ∧ ?yswsw]_zs)" using sw_compose .
hence *: "?usw22 = ?usw11" by simp
show "?rhosw11 us u = ?rhosw22 us u"
proof(cases "rho us ?usw11")
case None
hence "?rhosw11 us u = None" unfolding swapEnv_defs lift_def by simp
also have "… = ?rhosw22 us u"
using None unfolding * swapEnv_defs lift_def by simp
finally show ?thesis .
next
case (Some X)
hence "good X" using good unfolding goodEnv_def liftAll_def by simp
have "?rhosw11 us u = Some(?Sw11 X)" using Some unfolding swapEnv_defs lift_def by simp
also have "?Sw11 X = ?Sw22 X"
using ‹good X› by(rule swap_compose)
also have "Some(?Sw22 X) = ?rhosw22 us u"
using Some unfolding * swapEnv_defs lift_def by simp
finally show ?thesis .
qed
qed
lemma swapEnv_commute:
"⟦goodEnv rho; {x,y} ⊆ var zs; zs ≠ zs' ∨ {x,y} ∩ {x',y'} = {}⟧ ⟹
((rho &[x ∧ y]_zs) &[x' ∧ y']_zs') = ((rho &[x' ∧ y']_zs') &[x ∧ y]_zs)"
using swapEnv_compose[of rho zs' x' y' zs x y] by(auto simp add: sw_def)
lemma swapEnv_involutive[simp]:
assumes "goodEnv rho"
shows "((rho &[x ∧ y]_zs) &[x ∧ y]_zs) = rho"
using assms unfolding swapEnv_defs lift_def
by (fastforce simp: option.case_eq_if)
theorem swapEnv_sym: "(rho &[x ∧ y]_zs) = (rho &[y ∧ x]_zs)"
proof(intro ext)
fix us u
have *: "(u @us[x ∧ y]_zs) = (u @us[y ∧ x]_zs)" using sw_sym by fastforce
show "(rho &[x ∧ y]_zs) us u = (rho &[y ∧ x]_zs) us u"
unfolding swapEnv_defs lift_def *
by(cases "rho us (u @us[y ∧ x]_zs)") (auto simp: swap_sym)
qed
lemma swapEnv_involutive2[simp]:
assumes good: "goodEnv rho"
shows "((rho &[x ∧ y]_zs) &[y ∧ x]_zs) = rho"
using assms by(simp add: swapEnv_sym)
lemma swapEnv_preserves_freshEnv[simp]:
assumes good: "goodEnv rho"
shows "freshEnv xs (x @xs[y1 ∧ y2]_ys) (rho &[y1 ∧ y2]_ys) = freshEnv xs x rho"
proof-
let ?xsw = "x @xs[y1 ∧ y2]_ys" let ?xswsw = "?xsw @xs[y1 ∧ y2]_ys"
let ?rhosw = "rho &[y1 ∧ y2]_ys"
let ?Left = "freshEnv xs ?xsw ?rhosw"
let ?Right = "freshEnv xs x rho"
have "(?rhosw xs ?xsw = None) = (rho xs x = None)"
unfolding freshEnv_def swapEnv_defs
by(simp add: lift_None sw_involutive)
moreover
have "(∀ zs z' Z'. ?rhosw zs z' = Some Z' ⟶ fresh xs ?xsw Z') =
(∀ zs z Z. rho zs z = Some Z ⟶ fresh xs x Z)"
proof(rule iff_allI, auto)
fix zs z Z assume *: "∀ z' Z'. ?rhosw zs z' = Some Z' ⟶ fresh xs ?xsw Z'"
and **: "rho zs z = Some Z" let ?z' = "z @zs[y1 ∧ y2]_ys" let ?Z' = "Z #[y1 ∧ y2]_ys"
have "?rhosw zs ?z' = Some ?Z'" using ** unfolding swapEnv_defs lift_def
by(simp add: sw_involutive)
hence "fresh xs ?xsw ?Z'" using * by simp
moreover have "good Z" using ** good unfolding goodEnv_def liftAll_def by simp
ultimately show "fresh xs x Z" using swap_preserves_fresh by auto
next
fix zs z' Z'
assume *: "∀z Z. rho zs z = Some Z ⟶ fresh xs x Z" and **: "?rhosw zs z' = Some Z'"
let ?z = "z' @zs[y1 ∧ y2]_ys"
obtain Z where rho: "rho zs ?z = Some Z" and Z': "Z' = Z #[y1 ∧ y2]_ys"
using ** unfolding swapEnv_defs lift_def by(cases "rho zs ?z", auto)
hence "fresh xs x Z" using * by simp
moreover have "good Z" using rho good unfolding goodEnv_def liftAll_def by simp
ultimately show "fresh xs ?xsw Z'" unfolding Z' using swap_preserves_fresh by auto
qed
ultimately show ?thesis unfolding freshEnv_def swapEnv_defs
unfolding liftAll_def by simp
qed
lemma swapEnv_preserves_freshEnv_distinct:
assumes "goodEnv rho" and
"xs ≠ ys ∨ x ∉ {y1,y2}"
shows "freshEnv xs x (rho &[y1 ∧ y2]_ys) = freshEnv xs x rho"
by (metis assms sw_simps3 swapEnv_preserves_freshEnv)
lemma freshEnv_swapEnv_exchange1:
assumes "goodEnv rho"
shows "freshEnv xs x2 (rho &[x1 ∧ x2]_xs) = freshEnv xs x1 rho"
by (metis assms sw_simps1 swapEnv_preserves_freshEnv)
lemma freshEnv_swapEnv_exchange2:
assumes "goodEnv rho"
shows "freshEnv xs x2 (rho &[x2 ∧ x1]_xs) = freshEnv xs x1 rho"
using assms by(simp add: freshEnv_swapEnv_exchange1 swapEnv_sym)
lemma freshEnv_swapEnv_id[simp]:
assumes good: "goodEnv rho" and
fresh: "freshEnv xs x1 rho" "freshEnv xs x2 rho"
shows "(rho &[x1 ∧ x2]_xs) = rho"
proof(intro ext)
fix us u
let ?usw = "u @us[x1 ∧ x2]_xs" let ?rhosw = "rho &[x1 ∧ x2]_xs"
let ?Sw = "λ X. (X #[x1 ∧ x2]_xs)"
show "?rhosw us u = rho us u"
proof(cases "rho us u")
case None
hence "rho us ?usw = None" using fresh unfolding freshEnv_def sw_def by auto
hence "?rhosw us u = None" unfolding swapEnv_defs lift_def by auto
with None show ?thesis by simp
next
case (Some X)
moreover have "?usw = u" using fresh Some unfolding freshEnv_def sw_def by auto
ultimately have "?rhosw us u = Some (?Sw X)" unfolding swapEnv_defs lift_def by auto
moreover
{have "good X" using Some good unfolding goodEnv_def liftAll_def by auto
moreover have "fresh xs x1 X" and "fresh xs x2 X"
using Some fresh unfolding freshEnv_def liftAll_def by auto
ultimately have "?Sw X = X" by simp
}
ultimately show ?thesis using Some by simp
qed
qed
lemma freshEnv_swapEnv_compose:
assumes good: "goodEnv rho" and
fresh: "freshEnv xs y rho" "freshEnv xs z rho"
shows "((rho &[y ∧ x]_xs) &[z ∧ y]_xs) = (rho &[z ∧ x]_xs)"
by (simp add: fresh good sw_def swapEnv_compose)
lemmas good_swapAll_freshAll_otherSimps =
swap_ident swap_involutive swap_involutive2 swap_preserves_fresh fresh_swap_id
freshAbs_swapAbs_id
swapEnv_ident swapEnv_involutive swapEnv_involutive2 swapEnv_preserves_freshEnv freshEnv_swapEnv_id
subsubsection ‹Properties of the relation of being swapped›
theorem swap_swapped: "(X, X #[x ∧ y]_zs) ∈ swapped"
by(auto simp add: swapped.Refl swapped.Swap)
lemma swapped_preserves_good:
assumes "good X" and "(X,Y) ∈ swapped"
shows "good Y"
using assms(2,1) by (induct rule: swapped.induct) auto
lemma swapped_skel:
assumes "good X" and "(X,Y) ∈ swapped"
shows "skel Y = skel X"
using assms(2,1)
by (induct rule: swapped.induct) (auto simp: swapped_preserves_good skel_swap)
lemma obtain_rep:
assumes GOOD: "good X" and FRESH: "fresh xs x' X"
shows "∃ X'. (X,X') ∈ swapped ∧ good X' ∧ Abs xs x X = Abs xs x' X'"
using Abs_swap_fresh FRESH GOOD swap_preserves_good swap_swapped by blast
subsection ‹Induction›
subsubsection ‹Induction lifted from quasi-terms›
lemma term_templateInduct[case_names rel Var Op Abs]:
fixes X::"('index,'bindex,'varSort,'var,'opSym)term" and
A::"('index,'bindex,'varSort,'var,'opSym)abs" and phi phiAbs rel
assumes
rel: "⋀ X Y. ⟦good X; (X,Y) ∈ rel⟧ ⟹ good Y ∧ skel Y = skel X" and
var: "⋀ xs x. phi (Var xs x)" and
op: "⋀ delta inp binp. ⟦goodInp inp; goodBinp binp; liftAll phi inp; liftAll phiAbs binp⟧
⟹ phi (Op delta inp binp)" and
abs: "⋀ xs x X. ⟦good X; ⋀ Y. (X,Y) ∈ rel ⟹ phi Y⟧
⟹ phiAbs (Abs xs x X)"
shows "(good X ⟶ phi X) ∧ (goodAbs A ⟶ phiAbs A)"
proof-
let ?qX = "pick X" let ?qA = "pick A"
let ?qphi = "phi o asTerm" let ?qphiAbs = "phiAbs o asAbs"
let ?qrel = "{(qY, qY')| qY qY'. (asTerm qY, asTerm qY') ∈ rel}"
have "(good X ⟶ qGood ?qX) ∧ (goodAbs A ⟶ qGoodAbs ?qA)"
using good_imp_qGood_pick goodAbs_imp_qGoodAbs_pick by auto
moreover
have "(good X ⟶ (?qphi ?qX = phi X)) ∧ (goodAbs A ⟶ (?qphiAbs ?qA = phiAbs A))"
using asTerm_pick asAbs_pick by fastforce
moreover
have "(qGood ?qX ⟶ ?qphi ?qX) ∧ (qGoodAbs ?qA ⟶ ?qphiAbs ?qA)"
proof(induction rule: qGood_qTerm_templateInduct[of ?qrel])
case (Rel qX qY)
thus ?case using qGood_iff_good_asTerm pick_asTerm unfolding skel_def
using rel skel_asTerm_qSkel
by simp (smt qGood_iff_good_asTerm skel_asTerm_qSkel)
next
case (Var xs x)
then show ?case using var unfolding Var_def by simp
next
case (Op delta qinp qbinp)
hence good_qinp: "qGoodInp qinp ∧ qGoodBinp qbinp"
unfolding qGoodInp_def qGoodBinp_def liftAll_def by simp
let ?inp = "asInp qinp" let ?binp = "asBinp qbinp"
have good_inp: "goodInp ?inp ∧ goodBinp ?binp"
using good_qinp qGoodInp_iff_goodInp_asInp qGoodBinp_iff_goodBinp_asBinp by auto
have 1: "Op delta ?inp ?binp = asTerm (qOp delta qinp qbinp)"
using good_qinp Op_asInp_asTerm_qOp by fastforce
{fix i X
assume inp: "?inp i = Some X"
then obtain qX where qinp: "qinp i = Some qX" and X: "X = asTerm qX"
unfolding asInp_def lift_def by(cases "qinp i", auto)
have "qGood qX ∧ phi (asTerm qX)" using qinp Op.IH by (simp add: liftAll_def)
hence "good X ∧ phi X" unfolding X using qGood_iff_good_asTerm by auto
}
moreover
{fix i A
assume binp: "?binp i = Some A"
then obtain qA where qbinp: "qbinp i = Some qA" and A: "A = asAbs qA"
unfolding asBinp_def lift_def by(cases "qbinp i", auto)
have "qGoodAbs qA ∧ phiAbs (asAbs qA)" using qbinp Op.IH by (simp add: liftAll_def)
hence "goodAbs A ∧ phiAbs A" unfolding A using qGoodAbs_iff_goodAbs_asAbs by auto
}
ultimately show ?case
using op[of ?inp ?binp delta] good_inp unfolding 1 liftAll_def by simp
next
case (Abs xs x qX)
have "good (asTerm qX)" using ‹qGood qX› qGood_iff_good_asTerm by auto
moreover
{fix Y assume *: "(asTerm qX, Y) ∈ rel"
obtain qY where qY: "qY = pick Y" by blast
have "good (asTerm qX)" using ‹qGood qX› qGood_iff_good_asTerm by auto
hence "good Y" using * rel by auto
hence Y: "Y = asTerm qY" unfolding qY using asTerm_pick by auto
have "phi Y" using * Abs.IH unfolding Y by simp
}
ultimately have "phiAbs (Abs xs x (asTerm qX))" using abs by simp
thus ?case using ‹qGood qX› Abs_asTerm_asAbs_qAbs by fastforce
qed
ultimately show ?thesis by blast
qed
lemma term_rawInduct[case_names Var Op Abs]:
fixes X::"('index,'bindex,'varSort,'var,'opSym)term" and
A::"('index,'bindex,'varSort,'var,'opSym)abs" and phi phiAbs
assumes
Var: "⋀ xs x. phi (Var xs x)" and
Op: "⋀ delta inp binp. ⟦goodInp inp; goodBinp binp; liftAll phi inp; liftAll phiAbs binp⟧
⟹ phi (Op delta inp binp)" and
Abs: "⋀ xs x X. ⟦good X; phi X⟧ ⟹ phiAbs (Abs xs x X)"
shows "(good X ⟶ phi X) ∧ (goodAbs A ⟶ phiAbs A)"
by(rule term_templateInduct[of Id], auto simp add: assms)
lemma term_induct[case_names Var Op Abs]:
fixes X::"('index,'bindex,'varSort,'var,'opSym)term" and
A::"('index,'bindex,'varSort,'var,'opSym)abs" and phi phiAbs
assumes
Var: "⋀ xs x. phi (Var xs x)" and
Op: "⋀ delta inp binp. ⟦goodInp inp; goodBinp binp; liftAll phi inp; liftAll phiAbs binp⟧
⟹ phi (Op delta inp binp)" and
Abs: "⋀ xs x X. ⟦good X;
⋀ Y. (X,Y) ∈ swapped ⟹ phi Y;
⋀ Y. ⟦good Y; skel Y = skel X⟧ ⟹ phi Y⟧
⟹ phiAbs (Abs xs x X)"
shows "(good X ⟶ phi X) ∧ (goodAbs A ⟶ phiAbs A)"
apply(induct rule: term_templateInduct[of "swapped ∪ {(X,Y). good Y ∧ skel Y = skel X}"])
by(auto simp: assms swapped_skel swapped_preserves_good)
subsubsection ‹Fresh induction›
text‹First a general situation, where parameters are of an unspecified type (that should be given by the user):›
lemma term_fresh_forall_induct[case_names PAR Var Op Abs]:
fixes X::"('index,'bindex,'varSort,'var,'opSym)term" and A::"('index,'bindex,'varSort,'var,'opSym)abs"
and phi and phiAbs and varsOf :: "'param ⇒ 'varSort ⇒ 'var set"
assumes
PAR: "⋀ p xs. ( |varsOf xs p| <o |UNIV::'var set| )" and
var: "⋀ xs x p. phi (Var xs x) p" and
op: "⋀ delta inp binp p.
⟦|{i. inp i ≠ None}| <o |UNIV::'var set|; |{i. binp i ≠ None}| <o |UNIV::'var set|;
liftAll (λ X. good X ∧ (∀ q. phi X p)) inp; liftAll (λ A. goodAbs A ∧ (∀ q. phiAbs A p)) binp⟧
⟹ phi (Op delta inp binp) p" and
abs: "⋀ xs x X p. ⟦good X; x ∉ varsOf p xs; phi X p⟧ ⟹ phiAbs (Abs xs x X) p"
shows "(good X ⟶ (∀ p. phi X p)) ∧ (goodAbs A ⟶ (∀ p. phiAbs A p))"
proof(induction rule: term_templateInduct[of swapped])
case (Abs xs x X)
show ?case proof safe
fix p
obtain x' where x'_freshP: "x' ∉ varsOf p xs" and x'_fresh_X: "fresh xs x' X"
using ‹good X› PAR obtain_fresh[of "varsOf p xs" "{X}" "{}" "{}" xs] by auto
then obtain X' where XX': "(X, X') ∈ swapped" and good_X': "good X'" and
Abs_eq: "Abs xs x X = Abs xs x' X'"
using ‹good X› x'_freshP x'_fresh_X using obtain_rep[of X xs x' x] by auto
thus "phiAbs (Abs xs x X) p"
unfolding Abs_eq using x'_freshP good_X' abs Abs.IH by simp
qed
qed(insert assms swapped_preserves_good swapped_skel,
unfold liftAll_def goodInp_def goodBinp_def, auto)
lemma term_templateInduct_fresh[case_names PAR Var Op Abs]:
fixes X::"('index,'bindex,'varSort,'var,'opSym)term" and
A::"('index,'bindex,'varSort,'var,'opSym)abs" and
rel and phi and phiAbs and
vars :: "'varSort ⇒ 'var set" and
terms :: "('index,'bindex,'varSort,'var,'opSym)term set" and
abs :: "('index,'bindex,'varSort,'var,'opSym)abs set" and
envs :: "('index,'bindex,'varSort,'var,'opSym)env set"
assumes
PAR:
"⋀ xs.
( |vars xs| <o |UNIV :: 'var set| ∨ finite (vars xs)) ∧
( |terms| <o |UNIV :: 'var set| ∨ finite terms) ∧ (∀ X ∈ terms. good X) ∧
( |abs| <o |UNIV :: 'var set| ∨ finite abs) ∧ (∀ A ∈ abs. goodAbs A) ∧
( |envs| <o |UNIV :: 'var set| ∨ finite envs) ∧ (∀ rho ∈ envs. goodEnv rho)" and
rel: "⋀ X Y. ⟦good X; (X,Y) ∈ rel⟧ ⟹ good Y ∧ skel Y = skel X" and
Var: "⋀ xs x. phi (Var xs x)" and
Op:
"⋀ delta inp binp.
⟦goodInp inp; goodBinp binp;
liftAll phi inp; liftAll phiAbs binp⟧
⟹ phi (Op delta inp binp)" and
abs:
"⋀ xs x X.
⟦good X;
x ∉ vars xs;
⋀ Y. Y ∈ terms ⟹ fresh xs x Y;
⋀ A. A ∈ abs ⟹ freshAbs xs x A;
⋀ rho. rho ∈ envs ⟹ freshEnv xs x rho;
⋀ Y. (X,Y) ∈ rel ⟹ phi Y⟧
⟹ phiAbs (Abs xs x X)"
shows
"(good X ⟶ phi X) ∧
(goodAbs A ⟶ phiAbs A)"
proof(induction rule: term_templateInduct[of "swapped O rel"])
case (Abs xs x X) note good_X = ‹good X›
have "|{X} ∪ terms| <o |UNIV :: 'var set| ∨ finite ({X} ∪ terms)"
apply(cases "finite terms", auto simp add: PAR)
using PAR var_infinite_INNER card_of_Un_singl_ordLess_infinite by force
then obtain x' where x'_not: "x' ∉ vars xs" and
x'_fresh_X: "fresh xs x' X" and
x'_freshP: "(∀ Y ∈ terms. fresh xs x' Y) ∧
(∀ A ∈ abs. freshAbs xs x' A) ∧
(∀ rho ∈ envs. freshEnv xs x' rho)"
using good_X PAR
using obtain_fresh[of "vars xs" "{X} ∪ terms" abs envs xs] by auto
then obtain X' where XX': "(X, X') ∈ swapped" and good_X': "good X'" and
Abs_eq: "Abs xs x X = Abs xs x' X'"
using good_X x'_not x'_fresh_X using obtain_rep[of X xs x' x] by auto
have "⋀Y. (X', Y) ∈ rel ⟹ phi Y" using XX' Abs.IH by auto
thus ?case
unfolding Abs_eq using x'_not x'_freshP good_X' abs by auto
qed(insert Op rel, unfold relcomp_unfold liftAll_def, simp_all add: Var,
metis rel swapped_preserves_good swapped_skel)
text‹A version of the above not employing any relation for the bound-argument case:›
lemma term_rawInduct_fresh[case_names Par Var Op Obs]:
fixes X::"('index,'bindex,'varSort,'var,'opSym)term" and
A::"('index,'bindex,'varSort,'var,'opSym)abs" and
vars :: "'varSort ⇒ 'var set" and
terms :: "('index,'bindex,'varSort,'var,'opSym)term set" and
abs :: "('index,'bindex,'varSort,'var,'opSym)abs set" and
envs :: "('index,'bindex,'varSort,'var,'opSym)env set"
assumes
PAR:
"⋀ xs.
( |vars xs| <o |UNIV :: 'var set| ∨ finite (vars xs)) ∧
( |terms| <o |UNIV :: 'var set| ∨ finite terms) ∧ (∀ X ∈ terms. good X) ∧
( |abs| <o |UNIV :: 'var set| ∨ finite abs) ∧ (∀ A ∈ abs. goodAbs A) ∧
( |envs| <o |UNIV :: 'var set| ∨ finite envs) ∧ (∀ rho ∈ envs. goodEnv rho)" and
Var: "⋀ xs x. phi (Var xs x)" and
Op:
"⋀ delta inp binp.
⟦goodInp inp; goodBinp binp;
liftAll phi inp; liftAll phiAbs binp⟧
⟹ phi (Op delta inp binp)" and
Abs:
"⋀ xs x X.
⟦good X;
x ∉ vars xs;
⋀ Y. Y ∈ terms ⟹ fresh xs x Y;
⋀ A. A ∈ abs ⟹ freshAbs xs x A;
⋀ rho. rho ∈ envs ⟹ freshEnv xs x rho;
phi X⟧
⟹ phiAbs (Abs xs x X)"
shows
"(good X ⟶ phi X) ∧
(goodAbs A ⟶ phiAbs A)"
apply(induct rule: term_templateInduct_fresh[of vars terms abs envs Id])
using assms by auto
text‹The typical raw induction with freshness is one dealing with
finitely many variables, terms, abstractions and environments as parameters --
we have all these condensed in the notion of a parameter (type
constructor ``param"):›
lemma term_induct_fresh[case_names Par Var Op Abs]:
fixes X :: "('index,'bindex,'varSort,'var,'opSym)term" and
A :: "('index,'bindex,'varSort,'var,'opSym)abs" and
P :: "('index,'bindex,'varSort,'var,'opSym)param"
assumes
goodP: "goodPar P" and
Var: "⋀ xs x. phi (Var xs x)" and
Op:
"⋀ delta inp binp.
⟦goodInp inp; goodBinp binp;
liftAll phi inp; liftAll phiAbs binp⟧
⟹ phi (Op delta inp binp)" and
Abs:
"⋀ xs x X.
⟦good X;
x ∉ varsOf P;
⋀ Y. Y ∈ termsOf P ⟹ fresh xs x Y;
⋀ A. A ∈ absOf P ⟹ freshAbs xs x A;
⋀ rho. rho ∈ envsOf P ⟹ freshEnv xs x rho;
phi X⟧
⟹ phiAbs (Abs xs x X)"
shows
"(good X ⟶ phi X) ∧
(goodAbs A ⟶ phiAbs A)"
proof(induct rule: term_rawInduct_fresh
[of "λ xs. varsOf P" "termsOf P" "absOf P" "envsOf P"])
case (Par xs)
then show ?case unfolding goodPar_def
using goodP by(cases P) simp
qed(insert assms, auto)
end
end
Theory Terms
section ‹More on Terms›
theory Terms imports Transition_QuasiTerms_Terms
begin
text‹In this section, we continue the study of terms, with stating and proving
properties specific to terms (while in the previous section we dealt with
lifting properties from quasi-terms).
Consequently, in this theory, not only the theorems, but neither the proofs
should mention quasi-items at all.
Among the properties specific to terms will
be the compositionality properties of substitution (while, by contrast, similar properties
of swapping also held for quasi-tems).
›
context FixVars
begin
declare qItem_simps[simp del]
declare qItem_versus_item_simps[simp del]
subsection ‹Identity environment versus other operators›
theorem getEnv_updEnv_idEnv[simp]:
"(idEnv [x ← X]_xs) ys y = (if (ys = xs ∧ y = x) then Some X else None)"
unfolding idEnv_def updEnv_def by simp
theorem subst_psubst_idEnv:
"(X #[Y / y]_ys) = (X #[idEnv [y ← Y]_ys])"
unfolding subst_def idEnv_def updEnv_def psubst_def by simp
theorem vsubst_psubst_idEnv:
"(X #[z // y]_ys) = (X #[idEnv [y ← Var ys z]_ys])"
unfolding vsubst_def by(simp add: subst_psubst_idEnv)
theorem substEnv_psubstEnv_idEnv:
"(rho &[Y / y]_ys) = (rho &[idEnv [y ← Y]_ys])"
unfolding substEnv_def idEnv_def updEnv_def psubstEnv_def by simp
theorem vsubstEnv_psubstEnv_idEnv:
"(rho &[z // y]_ys) = (rho &[idEnv [y ← Var ys z]_ys])"
unfolding vsubstEnv_def by (simp add: substEnv_psubstEnv_idEnv)
theorem freshEnv_idEnv: "freshEnv xs x idEnv"
unfolding idEnv_def freshEnv_def liftAll_def by simp
theorem swapEnv_idEnv[simp]: "(idEnv &[x ∧ y]_xs) = idEnv"
unfolding idEnv_def swapEnv_def comp_def swapEnvDom_def swapEnvIm_def lift_def by simp
theorem psubstEnv_idEnv[simp]: "(idEnv &[rho]) = rho"
unfolding idEnv_def psubstEnv_def lift_def by simp
theorem substEnv_idEnv: "(idEnv &[X / x]_xs) = (idEnv [x ← X]_xs)"
unfolding substEnv_def using psubstEnv_idEnv by auto
theorem vsubstEnv_idEnv: "(idEnv &[y // x]_xs) = (idEnv [x ← (Var xs y)]_xs)"
unfolding vsubstEnv_def using substEnv_idEnv .
lemma psubstAll_idEnv:
fixes X::"('index,'bindex,'varSort,'var,'opSym)term" and
A::"('index,'bindex,'varSort,'var,'opSym)abs"
shows
"(good X ⟶ (X #[idEnv]) = X) ∧
(goodAbs A ⟶ (A $[idEnv]) = A)"
apply(induct rule: term_rawInduct)
unfolding psubstInp_def psubstBinp_def
using idEnv_preserves_good psubst_Var_simp1
by (simp_all del: getEnv_idEnv add:
liftAll_lift_ext lift_ident freshEnv_idEnv psubstBinp_def psubstInp_def)
fastforce+
lemma psubst_idEnv[simp]:
"good X ⟹ (X #[idEnv]) = X"
by(simp add: psubstAll_idEnv)
lemma psubstEnv_idEnv_id[simp]:
assumes "goodEnv rho"
shows "(rho &[idEnv]) = rho"
using assms unfolding psubstEnv_def lift_def goodEnv_def liftAll_def
apply(intro ext) subgoal for xs x by(cases "rho xs x") auto .
subsection ‹Environment update versus other operators›
theorem updEnv_overwrite[simp]: "((rho [x ← X]_xs) [x ← X']_xs) = (rho [x ← X']_xs)"
unfolding updEnv_def by fastforce
theorem updEnv_commute:
assumes "xs ≠ ys ∨ x ≠ y"
shows "((rho [x ← X]_xs) [y ← Y]_ys) = ((rho [y ← Y]_ys) [x ← X]_xs)"
using assms unfolding updEnv_def by fastforce
theorem freshEnv_updEnv_E1:
assumes "freshEnv xs y (rho [x ← X]_xs)"
shows "y ≠ x"
using assms unfolding freshEnv_def liftAll_def updEnv_def by auto
theorem freshEnv_updEnv_E2:
assumes "freshEnv ys y (rho [x ← X]_xs)"
shows "fresh ys y X"
using assms unfolding freshEnv_def liftAll_def updEnv_def
by (auto split: if_splits)
theorem freshEnv_updEnv_E3:
assumes "freshEnv ys y (rho [x ← X]_xs)"
shows "rho ys y = None"
using assms freshEnv_updEnv_E1[of ys y] unfolding freshEnv_def
by (metis getEnv_updEnv option.simps(3))
theorem freshEnv_updEnv_E4:
assumes "freshEnv ys y (rho [x ← X]_xs)"
and "zs ≠ xs ∨ z ≠ x" and "rho zs z = Some Z"
shows "fresh ys y Z"
using assms unfolding freshEnv_def liftAll_def
by (metis getEnv_updEnv1)
theorem freshEnv_updEnv_I:
assumes "ys ≠ xs ∨ y ≠ x" and "fresh ys y X" and "rho ys y = None"
and "⋀ zs z Z. ⟦zs ≠ xs ∨ z ≠ x; rho zs z = Some Z⟧ ⟹ fresh ys y Z"
shows "freshEnv ys y (rho [x ← X]_xs)"
unfolding freshEnv_def liftAll_def
using assms by auto
theorem swapEnv_updEnv:
"((rho [x ← X]_xs) &[y1 ∧ y2]_ys) =
((rho &[y1 ∧ y2]_ys) [(x @xs[y1 ∧ y2]_ys) ← (X #[y1 ∧ y2]_ys)]_xs)"
unfolding swapEnv_defs sw_def lift_def
by(cases "xs = ys") fastforce+
lemma swapEnv_updEnv_fresh:
assumes "ys ≠ xs ∨ x ∉ {y1,y2}" and "good X"
and "fresh ys y1 X" and "fresh ys y2 X"
shows "((rho [x ← X]_xs) &[y1 ∧ y2]_ys) =
((rho &[y1 ∧ y2]_ys) [x ← X]_xs)"
using assms by(simp add: swapEnv_updEnv)
theorem psubstEnv_updEnv:
"((rho [x ← X]_xs) &[rho']) = ((rho &[rho']) [x ← (X #[rho'])]_xs)"
unfolding psubstEnv_def by fastforce
theorem psubstEnv_updEnv_idEnv:
"((idEnv [x ← X]_xs) &[rho]) = (rho [x ← (X #[rho])]_xs)"
by(simp add: psubstEnv_updEnv)
theorem substEnv_updEnv:
"((rho [x ← X]_xs) &[Y / y]_ys) = ((rho &[Y / y]_ys) [x ← (X #[Y / y]_ys)]_xs)"
unfolding substEnv_def subst_def by(rule psubstEnv_updEnv)
theorem vsubstEnv_updEnv:
"((rho [x ← X]_xs) &[y1 // y]_ys) = ((rho &[y1 // y]_ys) [x ← (X #[y1 // y]_ys)]_xs)"
unfolding vsubstEnv_def vsubst_def using substEnv_updEnv .
subsection ‹Environment ``get" versus other operators›
text‹Currently, ``get" is just function application. While the next
properties are immediate consequences of the definitions, it is worth stating
them because of their abstract character (since later, concrete terms
inferred from abstract terms by a presumptive package, ``get" will no longer
be function application).›
theorem getEnv_ext:
assumes "⋀ xs x. rho xs x = rho' xs x"
shows "rho = rho'"
using assms by(simp add: ext)
theorem freshEnv_getEnv1[simp]:
"⟦freshEnv ys y rho; rho xs x = Some X⟧ ⟹ ys ≠ xs ∨ y ≠ x"
unfolding freshEnv_def by auto
theorem freshEnv_getEnv2[simp]:
"⟦freshEnv ys y rho; rho xs x = Some X⟧ ⟹ fresh ys y X"
unfolding freshEnv_def liftAll_def by simp
theorem freshEnv_getEnv[simp]:
"freshEnv ys y rho ⟹ rho ys y = None"
unfolding freshEnv_def by simp
theorem getEnv_swapEnv1[simp]:
assumes "rho xs (x @xs [z1 ∧ z2]_zs) = None"
shows "(rho &[z1 ∧ z2]_zs) xs x = None"
using assms unfolding swapEnv_defs lift_def by simp
theorem getEnv_swapEnv2[simp]:
assumes "rho xs (x @xs [z1 ∧ z2]_zs) = Some X"
shows "(rho &[z1 ∧ z2]_zs) xs x = Some (X #[z1 ∧ z2]_zs)"
using assms unfolding swapEnv_defs lift_def by simp
theorem getEnv_psubstEnv_None[simp]:
assumes "rho xs x = None"
shows "(rho &[rho']) xs x = rho' xs x"
using assms unfolding psubstEnv_def by simp
theorem getEnv_psubstEnv_Some[simp]:
assumes "rho xs x = Some X"
shows "(rho &[rho']) xs x = Some (X #[rho'])"
using assms unfolding psubstEnv_def by simp
theorem getEnv_substEnv1[simp]:
assumes "ys ≠ xs ∨ y ≠ x" and "rho xs x = None"
shows "(rho &[Y / y]_ys) xs x = None"
using assms unfolding substEnv_def2 by auto
theorem getEnv_substEnv2[simp]:
assumes "ys ≠ xs ∨ y ≠ x" and "rho xs x = Some X"
shows "(rho &[Y / y]_ys) xs x = Some (X #[Y / y]_ys)"
using assms unfolding substEnv_def2 by auto
theorem getEnv_substEnv3[simp]:
"⟦ys ≠ xs ∨ y ≠ x; freshEnv xs x rho⟧
⟹ (rho &[Y / y]_ys) xs x = None"
using getEnv_substEnv1 by auto
theorem getEnv_substEnv4[simp]:
"freshEnv ys y rho ⟹ (rho &[Y / y]_ys) ys y = Some Y"
unfolding substEnv_psubstEnv_idEnv by simp
theorem getEnv_vsubstEnv1[simp]:
assumes "ys ≠ xs ∨ y ≠ x" and "rho xs x = None"
shows "(rho &[y1 // y]_ys) xs x = None"
using assms unfolding vsubstEnv_def by auto
theorem getEnv_vsubstEnv2[simp]:
assumes "ys ≠ xs ∨ y ≠ x" and "rho xs x = Some X"
shows "(rho &[y1 // y]_ys) xs x = Some (X #[y1 // y]_ys)"
using assms unfolding vsubstEnv_def vsubst_def by auto
theorem getEnv_vsubstEnv3[simp]:
"⟦ys ≠ xs ∨ y ≠ x; freshEnv xs x rho⟧
⟹ (rho &[z // y]_ys) xs x = None"
using getEnv_vsubstEnv1 by auto
theorem getEnv_vsubstEnv4[simp]:
"freshEnv ys y rho ⟹ (rho &[z // y]_ys) ys y = Some (Var ys z)"
unfolding vsubstEnv_psubstEnv_idEnv by simp
subsection ‹Substitution versus other operators›
definition freshImEnvAt ::
"'varSort ⇒ 'var ⇒ ('index,'bindex,'varSort,'var,'opSym)env ⇒ 'varSort ⇒ 'var ⇒ bool"
where
"freshImEnvAt xs x rho ys y ==
rho ys y = None ∧ (ys ≠ xs ∨ y ≠ x) ∨
(∃ Y. rho ys y = Some Y ∧ fresh xs x Y)"
lemma freshAll_psubstAll:
fixes X::"('index,'bindex,'varSort,'var,'opSym)term" and
A::"('index,'bindex,'varSort,'var,'opSym)abs" and
P::"('index,'bindex,'varSort,'var,'opSym)param" and x
assumes goodP: "goodPar P"
shows
"(good X ⟶ z ∈ varsOf P ⟶
(∀ rho ∈ envsOf P.
fresh zs z (X #[rho]) =
(∀ ys. ∀ y. fresh ys y X ∨ freshImEnvAt zs z rho ys y)))
∧
(goodAbs A ⟶ z ∈ varsOf P ⟶
(∀ rho ∈ envsOf P.
freshAbs zs z (A $[rho]) =
(∀ ys. ∀ y. freshAbs ys y A ∨ freshImEnvAt zs z rho ys y)))"
proof(induction rule: term_induct_fresh[of P])
case Par
then show ?case using goodP by simp
next
case (Var ys y)
thus ?case proof clarify
fix rho
assume r: "rho ∈ envsOf P"
hence g: "goodEnv rho" using goodP by simp
thus "fresh zs z (psubst rho (Var ys y)) =
(∀ysa ya. fresh ysa ya (Var ys y) ∨ freshImEnvAt zs z rho ysa ya)"
unfolding freshImEnvAt_def
by(cases "ys = zs ∧ y = z", (cases "rho ys y", auto)+)
qed
next
case (Op delta inp binp)
show ?case proof clarify
fix rho
assume P: "z ∈ varsOf P" "rho ∈ envsOf P"
let ?L1 = "liftAll (fresh zs z ∘ psubst rho) inp"
let ?L2 = "liftAll (freshAbs zs z ∘ psubstAbs rho) binp"
let ?R1 = "%ys y. liftAll (fresh ys y) inp"
let ?R2 = "%ys y. liftAll (freshAbs ys y) binp"
let ?R3 = "%ys y. freshImEnvAt zs z rho ys y"
have "(?L1 ∧ ?L2) = (∀ys y. ?R1 ys y ∧ ?R2 ys y ∨ ?R3 ys y)"
using Op.IH P unfolding liftAll_def by simp blast
thus "fresh zs z ((Op delta inp binp) #[rho]) =
(∀ys y. fresh ys y (Op delta inp binp) ∨ freshImEnvAt zs z rho ys y)"
by (metis (no_types, lifting) Op.hyps(1) Op.hyps(2) P(2) envsOf_preserves_good freshBinp_def freshInp_def fresh_Op_simp goodP liftAll_lift_comp psubstBinp_def psubstBinp_preserves_good
psubstInp_def psubstInp_preserves_good psubst_Op_simp)
qed
next
case (Abs xs x X)
thus ?case
using goodP by simp (metis (full_types) freshEnv_def freshImEnvAt_def)
qed
corollary fresh_psubst:
assumes "good X" and "goodEnv rho"
shows
"fresh zs z (X #[rho]) =
(∀ ys y. fresh ys y X ∨ freshImEnvAt zs z rho ys y)"
using assms freshAll_psubstAll[of "Par [z] [] [] [rho]"]
unfolding goodPar_def by simp
corollary fresh_psubst_E1:
assumes "good X" and "goodEnv rho"
and "rho ys y = None" and "fresh zs z (X #[rho])"
shows "fresh ys y X ∨ (ys ≠ zs ∨ y ≠ z)"
using assms fresh_psubst unfolding freshImEnvAt_def by fastforce
corollary fresh_psubst_E2:
assumes "good X" and "goodEnv rho"
and "rho ys y = Some Y" and "fresh zs z (X #[rho])"
shows "fresh ys y X ∨ fresh zs z Y"
using assms fresh_psubst[of X rho] unfolding freshImEnvAt_def by fastforce
corollary fresh_psubst_I1:
assumes "good X" and "goodEnv rho"
and "fresh zs z X" and "freshEnv zs z rho"
shows "fresh zs z (X #[rho])"
using assms apply(simp add: fresh_psubst)
unfolding freshEnv_def liftAll_def freshImEnvAt_def by auto
corollary psubstEnv_preserves_freshEnv:
assumes good: "goodEnv rho" "goodEnv rho'"
and fresh: "freshEnv zs z rho" "freshEnv zs z rho'"
shows "freshEnv zs z (rho &[rho'])"
using assms unfolding freshEnv_def liftAll_def
by simp (smt Var_preserves_good fresh(2) fresh_psubst_I1 option.case_eq_if
option.exhaust_sel option.sel psubstEnv_def psubst_Var_simp2 psubst_preserves_good)
corollary fresh_psubst_I:
assumes "good X" and "goodEnv rho"
and "rho zs z = None ⟹ fresh zs z X" and
"⋀ ys y Y. rho ys y = Some Y ⟹ fresh ys y X ∨ fresh zs z Y"
shows "fresh zs z (X #[rho])"
using assms unfolding freshImEnvAt_def
by (simp add: fresh_psubst) (metis freshImEnvAt_def not_None_eq)
lemma fresh_subst:
assumes "good X" and "good Y"
shows "fresh zs z (X #[Y / y]_ys) =
(((zs = ys ∧ z = y) ∨ fresh zs z X) ∧ (fresh ys y X ∨ fresh zs z Y))"
using assms unfolding subst_def freshImEnvAt_def
by (simp add: fresh_psubst)
(metis (no_types, lifting) freshImEnvAt_def fresh_psubst fresh_psubst_E2
getEnv_updEnv_idEnv idEnv_preserves_good option.simps(3) updEnv_preserves_good)
lemma fresh_vsubst:
assumes "good X"
shows "fresh zs z (X #[y1 // y]_ys) =
(((zs = ys ∧ z = y) ∨ fresh zs z X) ∧ (fresh ys y X ∨ (zs ≠ ys ∨ z ≠ y1)))"
unfolding vsubst_def using assms by(auto simp: fresh_subst)
lemma subst_preserves_fresh:
assumes "good X" and "good Y"
and "fresh zs z X" and "fresh zs z Y"
shows "fresh zs z (X #[Y / y]_ys)"
using assms by(simp add: fresh_subst)
lemma substEnv_preserves_freshEnv_aux:
assumes rho: "goodEnv rho" and Y: "good Y"
and fresh_rho: "freshEnv zs z rho" and fresh_Y: "fresh zs z Y" and diff: "zs ≠ ys ∨ z ≠ y"
shows "freshEnv zs z (rho &[Y / y]_ys)"
using assms unfolding freshEnv_def liftAll_def
by (simp add: option.case_eq_if substEnv_def2 subst_preserves_fresh)
lemma substEnv_preserves_freshEnv:
assumes rho: "goodEnv rho" and Y: "good Y"
and fresh_rho: "freshEnv zs z rho" and fresh_Y: "fresh zs z Y" and diff: "zs ≠ ys ∨ z ≠ y"
shows "freshEnv zs z (rho &[Y / y]_ys)"
using assms by(simp add: substEnv_preserves_freshEnv_aux)
lemma vsubst_preserves_fresh:
assumes "good X"
and "fresh zs z X" and "zs ≠ ys ∨ z ≠ y1"
shows "fresh zs z (X #[y1 // y]_ys)"
using assms by(simp add: fresh_vsubst)
lemma vsubstEnv_preserves_freshEnv:
assumes rho: "goodEnv rho"
and fresh_rho: "freshEnv zs z rho" and diff: "zs ≠ ys ∨ z ∉ {y,y1}"
shows "freshEnv zs z (rho &[y1 // y]_ys)"
using assms unfolding vsubstEnv_def
by(simp add: substEnv_preserves_freshEnv)
lemma fresh_fresh_subst[simp]:
assumes "good Y" and "good X"
and "fresh ys y Y"
shows "fresh ys y (X #[Y / y]_ys)"
using assms by(simp add: fresh_subst)
lemma diff_fresh_vsubst[simp]:
assumes "good X"
and "y ≠ y1"
shows "fresh ys y (X #[y1 // y]_ys)"
using assms by(simp add: fresh_vsubst)
lemma fresh_subst_E1:
assumes "good X" and "good Y"
and "fresh zs z (X #[Y / y]_ys)" and "zs ≠ ys ∨ z ≠ y"
shows "fresh zs z X"
using assms by(auto simp add: fresh_subst)
lemma fresh_vsubst_E1:
assumes "good X"
and "fresh zs z (X #[y1 // y]_ys)" and "zs ≠ ys ∨ z ≠ y"
shows "fresh zs z X"
using assms by(auto simp add: fresh_vsubst)
lemma fresh_subst_E2:
assumes "good X" and "good Y"
and "fresh zs z (X #[Y / y]_ys)"
shows "fresh ys y X ∨ fresh zs z Y"
using assms by(simp add: fresh_subst)
lemma fresh_vsubst_E2:
assumes "good X"
and "fresh zs z (X #[y1 // y]_ys)"
shows "fresh ys y X ∨ zs ≠ ys ∨ z ≠ y1"
using assms by(simp add: fresh_vsubst)
lemma psubstAll_cong:
fixes X::"('index,'bindex,'varSort,'var,'opSym)term" and
A::"('index,'bindex,'varSort,'var,'opSym)abs" and
P::"('index,'bindex,'varSort,'var,'opSym)param"
assumes goodP: "goodPar P"
shows
"(good X ⟶
(∀ rho rho'. {rho, rho'} ⊆ envsOf P ⟶
(∀ ys. ∀ y. fresh ys y X ∨ rho ys y = rho' ys y) ⟶
(X #[rho]) = (X #[rho'])))
∧
(goodAbs A ⟶
(∀ rho rho'. {rho, rho'} ⊆ envsOf P ⟶
(∀ ys. ∀ y. freshAbs ys y A ∨ rho ys y = rho' ys y) ⟶
(A $[rho]) = (A $[rho'])))"
proof(induction rule: term_induct_fresh[of P])
case Par
then show ?case using assms .
next
case (Var xs x)
then show ?case using goodP by (auto simp: psubst_Var)
next
case (Op delta inp binp)
show ?case proof clarify
fix rho rho'
assume envs: "{rho, rho'} ⊆ envsOf P"
hence goodEnv: "goodEnv rho ∧ goodEnv rho'" using goodP by simp
assume "∀ys y. fresh ys y (Op delta inp binp) ∨ rho ys y = rho' ys y"
hence 1: "liftAll (λ X. ∀ys y. fresh ys y X ∨ rho ys y = rho' ys y) inp ∧
liftAll (λ A. ∀ys y. freshAbs ys y A ∨ rho ys y = rho' ys y) binp"
using Op by simp (smt freshBinp_def freshInp_def liftAll_def)
have "liftAll (λ X. (X #[rho]) = (X #[rho'])) inp ∧
liftAll (λ A. (A $[rho]) = (A $[rho'])) binp"
using Op.IH 1 envs by (auto simp: liftAll_def)
thus "(Op delta inp binp) #[rho] = (Op delta inp binp) #[rho']"
using Op.IH 1
by (simp add: Op.hyps goodEnv psubstBinp_def psubstInp_def liftAll_lift_ext)
qed
next
case (Abs xs x X)
thus ?case
using Abs goodP unfolding freshEnv_def liftAll_def
by simp (metis Abs.hyps(5) envsOf_preserves_good psubstAbs_simp)
qed
corollary psubst_cong[fundef_cong]:
assumes "good X" and "goodEnv rho" and "goodEnv rho'"
and "⋀ ys y. fresh ys y X ∨ rho ys y = rho' ys y"
shows "(X #[rho]) = (X #[rho'])"
using assms psubstAll_cong[of "Par [] [] [] [rho,rho']"]
unfolding goodPar_def by simp
lemma fresh_psubst_updEnv:
assumes "good X" and "good Y" and "goodEnv rho"
and "fresh xs x Y"
shows "(Y #[rho [x ← X]_xs]) = (Y #[rho])"
using assms by (auto cong: psubst_cong)
lemma psubstAll_ident:
fixes X :: "('index,'bindex,'varSort,'var,'opSym)term" and
A :: "('index,'bindex,'varSort,'var,'opSym)abs" and
P :: "('index,'bindex,'varSort,'var,'opSym) Transition_QuasiTerms_Terms.param"
assumes P: "goodPar P"
shows
"(good X ⟶
(∀ rho ∈ envsOf P.
(∀ zs z. freshEnv zs z rho ∨ fresh zs z X)
⟶ (X #[rho]) = X))
∧
(goodAbs A ⟶
(∀ rho ∈ envsOf P.
(∀ zs z. freshEnv zs z rho ∨ freshAbs zs z A)
⟶ (A $[rho]) = A))"
proof(induction rule: term_induct_fresh)
case (Var xs x)
then show ?case
by (meson assms freshEnv_def fresh_Var_simp goodPar_def psubst_Var_simp1)
next
case (Op delta inp binp)
then show ?case
by (metis (no_types,lifting) Op_preserves_good assms envsOf_preserves_good
freshEnv_getEnv idEnv_def idEnv_preserves_good psubst_cong psubst_idEnv)
qed(insert P, fastforce+)
corollary freshEnv_psubst_ident[simp]:
fixes X :: "('index,'bindex,'varSort,'var,'opSym)term"
assumes "good X" and "goodEnv rho"
and "⋀ zs z. freshEnv zs z rho ∨ fresh zs z X"
shows "(X #[rho]) = X"
using assms psubstAll_ident[of "Par [] [] [] [rho]"]
unfolding goodPar_def by simp
lemma fresh_subst_ident[simp]:
assumes "good X" and "good Y" and "fresh xs x Y"
shows "(Y #[X / x]_xs) = Y"
by (simp add: assms fresh_psubst_updEnv subst_def)
corollary substEnv_updEnv_fresh:
assumes "good X" and "good Y" and "fresh ys y X"
shows "((rho [x ← X]_xs) &[Y / y]_ys) = ((rho &[Y / y]_ys) [x ← X]_xs)"
using assms by(simp add: substEnv_updEnv)
lemma fresh_substEnv_updEnv[simp]:
assumes rho: "goodEnv rho" and Y: "good Y"
and *: "freshEnv ys y rho"
shows "(rho &[Y / y]_ys) = (rho [y ← Y]_ys)"
apply (rule getEnv_ext)
subgoal for xs x using assms by (cases "rho xs x") auto .
lemma fresh_vsubst_ident[simp]:
assumes "good Y" and "fresh xs x Y"
shows "(Y #[x1 // x]_xs) = Y"
using assms unfolding vsubst_def by simp
corollary vsubstEnv_updEnv_fresh:
assumes "good X" and "fresh ys y X"
shows "((rho [x ← X]_xs) &[y1 // y]_ys) = ((rho &[y1 // y]_ys) [x ← X]_xs)"
using assms by(simp add: vsubstEnv_updEnv)
lemma fresh_vsubstEnv_updEnv[simp]:
assumes rho: "goodEnv rho"
and *: "freshEnv ys y rho"
shows "(rho &[y1 // y]_ys) = (rho [y ← Var ys y1]_ys)"
using assms unfolding vsubstEnv_def by simp
lemma swapAll_psubstAll:
fixes X::"('index,'bindex,'varSort,'var,'opSym)term" and
A::"('index,'bindex,'varSort,'var,'opSym)abs" and
P::"('index,'bindex,'varSort,'var,'opSym)param"
assumes P: "goodPar P"
shows
"(good X ⟶
(∀ rho z1 z2. rho ∈ envsOf P ∧ {z1,z2} ⊆ varsOf P ⟶
((X #[rho]) #[z1 ∧ z2]_zs) = ((X #[z1 ∧ z2]_zs) #[rho &[z1 ∧ z2]_zs])))
∧
(goodAbs A ⟶
(∀ rho z1 z2. rho ∈ envsOf P ∧ {z1,z2} ⊆ varsOf P ⟶
((A $[rho]) $[z1 ∧ z2]_zs) = ((A $[z1 ∧ z2]_zs) $[rho &[z1 ∧ z2]_zs])))"
proof(induction rule: term_induct_fresh[of P])
case (Var xs x)
then show ?case using assms
by simp (smt Var_preserves_good envsOf_preserves_good getEnv_swapEnv1 getEnv_swapEnv2 option.case_eq_if option.exhaust_sel psubst_Var psubst_Var_simp2 swapEnv_preserves_good
swap_Var_simp swap_involutive2 swap_sym)
next
case (Op delta inp binp)
then show ?case
using assms
unfolding psubstInp_def swapInp_def psubstBinp_def swapBinp_def lift_comp
unfolding liftAll_def lift_def
by simp (auto simp: lift_def psubstInp_def swapInp_def
psubstBinp_def swapBinp_def split: option.splits)
qed(insert assms, auto)
lemma swap_psubst:
assumes "good X" and "goodEnv rho"
shows "((X #[rho]) #[z1 ∧ z2]_zs) = ((X #[z1 ∧ z2]_zs) #[rho &[z1 ∧ z2]_zs])"
using assms swapAll_psubstAll[of "Par [z1,z2] [] [] [rho]"]
unfolding goodPar_def by auto
lemma swap_subst:
assumes "good X" and "good Y"
shows "((X #[Y / y]_ys) #[z1 ∧ z2]_zs) =
((X #[z1 ∧ z2]_zs) #[(Y #[z1 ∧ z2]_zs) / (y @ys[z1 ∧ z2]_zs)]_ys)"
proof-
have 1: "(idEnv [(y @ys[z1 ∧ z2]_zs) ← (Y #[z1 ∧ z2]_zs)]_ys) =
((idEnv [y ← Y]_ys) &[z1 ∧ z2]_zs)"
by(simp add: swapEnv_updEnv)
show ?thesis
using assms unfolding subst_def 1 by (intro swap_psubst) auto
qed
lemma swap_vsubst:
assumes "good X"
shows "((X #[y1 // y]_ys) #[z1 ∧ z2]_zs) =
((X #[z1 ∧ z2]_zs) #[(y1 @ys[z1 ∧ z2]_zs) // (y @ys[z1 ∧ z2]_zs)]_ys)"
using assms unfolding vsubst_def
by(simp add: swap_subst)
lemma swapEnv_psubstEnv:
assumes "goodEnv rho" and "goodEnv rho'"
shows "((rho &[rho']) &[z1 ∧ z2]_zs) = ((rho &[z1 ∧ z2]_zs) &[rho' &[z1 ∧ z2]_zs])"
using assms apply(intro ext)
subgoal for xs x
by (cases "rho xs (x @xs[z1 ∧ z2]_zs)")
(auto simp: lift_def swapEnv_defs swap_psubst) .
lemma swapEnv_substEnv:
assumes "good Y" and "goodEnv rho"
shows "((rho &[Y / y]_ys) &[z1 ∧ z2]_zs) =
((rho &[z1 ∧ z2]_zs) &[(Y #[z1 ∧ z2]_zs) / (y @ys[z1 ∧ z2]_zs)]_ys)"
proof-
have 1: "(idEnv [(y @ys[z1 ∧ z2]_zs) ← (Y #[z1 ∧ z2]_zs)]_ys) =
((idEnv [y ← Y]_ys) &[z1 ∧ z2]_zs)"
by(simp add: swapEnv_updEnv)
show ?thesis
unfolding substEnv_def 1
using assms by (intro swapEnv_psubstEnv) auto
qed
lemma swapEnv_vsubstEnv:
assumes "goodEnv rho"
shows "((rho &[y1 // y]_ys) &[z1 ∧ z2]_zs) =
((rho &[z1 ∧ z2]_zs) &[(y1 @ys[z1 ∧ z2]_zs) // (y @ys[z1 ∧ z2]_zs)]_ys)"
using assms unfolding vsubstEnv_def by(simp add: swapEnv_substEnv)
lemma psubstAll_compose:
fixes X::"('index,'bindex,'varSort,'var,'opSym)term" and
A::"('index,'bindex,'varSort,'var,'opSym)abs" and
P::"('index,'bindex,'varSort,'var,'opSym)param"
assumes P: "goodPar P"
shows
"(good X ⟶
(∀ rho rho'. {rho,rho'} ⊆ envsOf P ⟶ ((X #[rho]) #[rho']) = (X #[(rho &[rho'])])))
∧
(goodAbs A ⟶
(∀ rho rho'. {rho,rho'} ⊆ envsOf P ⟶ ((A $[rho]) $[rho']) = (A $[(rho &[rho'])])))"
proof(induction rule: term_induct_fresh[of P])
case (Var xs x)
then show ?case using assms
by simp (smt envsOf_preserves_good option.case_eq_if option.sel psubstEnv_def
psubstEnv_idEnv_id psubstEnv_preserves_good psubst_Var_simp1 psubst_Var_simp2)
next
case (Op delta inp binp)
then show ?case
using assms
unfolding psubstInp_def swapInp_def psubstBinp_def swapBinp_def lift_comp
unfolding liftAll_def lift_def
by simp (auto simp: lift_def psubstInp_def swapInp_def
psubstBinp_def swapBinp_def split: option.splits)
qed(insert assms, simp_all add: psubstEnv_preserves_freshEnv)
corollary psubst_compose:
assumes "good X" and "goodEnv rho" and "goodEnv rho'"
shows "((X #[rho]) #[rho']) = (X #[(rho &[rho'])])"
using assms psubstAll_compose[of "Par [] [] [] [rho, rho']"]
unfolding goodPar_def by auto
lemma psubstEnv_compose:
assumes "goodEnv rho" and "goodEnv rho'" and "goodEnv rho''"
shows "((rho &[rho']) &[rho'']) = (rho &[(rho' &[rho''])])"
using assms apply(intro ext)
subgoal for xs x
by (cases "rho xs x") (auto simp: lift_def psubstEnv_def psubst_compose) .
lemma psubst_subst_compose:
assumes "good X" and "good Y" and "goodEnv rho"
shows "((X #[Y / y]_ys) #[rho]) = (X #[(rho [y ← (Y #[rho])]_ys)])"
by (simp add: assms psubstEnv_updEnv_idEnv psubst_compose subst_psubst_idEnv)
lemma psubstEnv_substEnv_compose:
assumes "goodEnv rho" and "good Y" and "goodEnv rho'"
shows "((rho &[Y / y]_ys) &[rho']) = (rho &[(rho' [y ← (Y #[rho'])]_ys)])"
by (simp add: assms psubstEnv_compose psubstEnv_updEnv_idEnv substEnv_def)
lemma psubst_vsubst_compose:
assumes "good X" and "goodEnv rho"
shows "((X #[y1 // y]_ys) #[rho]) = (X #[(rho [y ← ((Var ys y1) #[rho])]_ys)])"
using assms unfolding vsubst_def by(simp add: psubst_subst_compose)
lemma psubstEnv_vsubstEnv_compose:
assumes "goodEnv rho" and "goodEnv rho'"
shows "((rho &[y1 // y]_ys) &[rho']) = (rho &[(rho' [y ← ((Var ys y1) #[rho'])]_ys)])"
using assms unfolding vsubstEnv_def by(simp add: psubstEnv_substEnv_compose)
lemma subst_psubst_compose:
assumes "good X" and "good Y" and "goodEnv rho"
shows "((X #[rho]) #[Y / y]_ys) = (X #[(rho &[Y / y]_ys)])"
unfolding subst_def substEnv_def using assms by(simp add: psubst_compose)
lemma substEnv_psubstEnv_compose:
assumes "goodEnv rho" and "good Y" and "goodEnv rho'"
shows "((rho &[rho']) &[Y / y]_ys) = (rho &[(rho' &[Y / y]_ys)])"
unfolding substEnv_def using assms by(simp add: psubstEnv_compose)
lemma psubst_subst_compose_freshEnv:
assumes "goodEnv rho" and "good X" and "good Y"
assumes "freshEnv ys y rho"
shows "((X #[Y / y]_ys) #[rho]) = ((X #[rho]) #[(Y #[rho]) / y]_ys)"
using assms by (simp add: subst_psubst_compose psubst_subst_compose)
lemma psubstEnv_substEnv_compose_freshEnv:
assumes "goodEnv rho" and "goodEnv rho'" and "good Y"
assumes "freshEnv ys y rho'"
shows "((rho &[Y / y]_ys) &[rho']) = ((rho &[rho']) &[(Y #[rho']) / y]_ys)"
using assms by (simp add: substEnv_psubstEnv_compose psubstEnv_substEnv_compose)
lemma vsubst_psubst_compose:
assumes "good X" and "goodEnv rho"
shows "((X #[rho]) #[y1 // y]_ys) = (X #[(rho &[y1 // y]_ys)])"
unfolding vsubst_def vsubstEnv_def using assms by(simp add: subst_psubst_compose)
lemma vsubstEnv_psubstEnv_compose:
assumes "goodEnv rho" and "goodEnv rho'"
shows "((rho &[rho']) &[y1 // y]_ys) = (rho &[(rho' &[y1 // y]_ys)])"
unfolding vsubstEnv_def using assms by(simp add: substEnv_psubstEnv_compose)
lemma subst_compose1:
assumes "good X" and "good Y1" and "good Y2"
shows "((X #[Y1 / y]_ys) #[Y2 / y]_ys) = (X #[(Y1 #[Y2 / y]_ys) / y]_ys)"
proof-
have "goodEnv (idEnv [y ← Y1]_ys) ∧ goodEnv (idEnv [y ← Y2]_ys)" using assms by simp
thus ?thesis using ‹good X› unfolding subst_def substEnv_def
by(simp add: psubst_compose psubstEnv_updEnv)
qed
lemma substEnv_compose1:
assumes "goodEnv rho" and "good Y1" and "good Y2"
shows "((rho &[Y1 / y]_ys) &[Y2 / y]_ys) = (rho &[(Y1 #[Y2 / y]_ys) / y]_ys)"
by (simp add: assms psubstEnv_compose psubstEnv_updEnv_idEnv substEnv_def subst_psubst_idEnv)
lemma subst_vsubst_compose1:
assumes "good X" and "good Y" and "y ≠ y1"
shows "((X #[y1 // y]_ys) #[Y / y]_ys) = (X #[y1 // y]_ys)"
using assms unfolding vsubst_def by(simp add: subst_compose1)
lemma substEnv_vsubstEnv_compose1:
assumes "goodEnv rho" and "good Y" and "y ≠ y1"
shows "((rho &[y1 // y]_ys) &[Y / y]_ys) = (rho &[y1 // y]_ys)"
using assms unfolding vsubst_def vsubstEnv_def by(simp add: substEnv_compose1)
lemma vsubst_subst_compose1:
assumes "good X" and "good Y"
shows "((X #[Y / y]_ys) #[y1 // y]_ys) = (X #[(Y #[y1 // y]_ys) / y]_ys)"
using assms unfolding vsubst_def by(simp add: subst_compose1)
lemma vsubstEnv_substEnv_compose1:
assumes "goodEnv rho" and "good Y"
shows "((rho &[Y / y]_ys) &[y1 // y]_ys) = (rho &[(Y #[y1 // y]_ys) / y]_ys)"
using assms unfolding vsubst_def vsubstEnv_def by(simp add: substEnv_compose1)
lemma vsubst_compose1:
assumes "good X"
shows "((X #[y1 // y]_ys) #[y2 // y]_ys) = (X #[(y1 @ys[y2 / y]_ys) // y]_ys)"
using assms unfolding vsubst_def
by(cases "y = y1") (auto simp: subst_compose1)
lemma vsubstEnv_compose1:
assumes "goodEnv rho"
shows "((rho &[y1 // y]_ys) &[y2 // y]_ys) = (rho &[(y1 @ys[y2 / y]_ys) // y]_ys)"
using assms unfolding vsubstEnv_def
by(cases "y = y1") (auto simp: substEnv_compose1)
lemma subst_compose2:
assumes "good X" and "good Y" and "good Z"
and "ys ≠ zs ∨ y ≠ z" and fresh: "fresh ys y Z"
shows "((X #[Y / y]_ys) #[Z / z]_zs) = ((X #[Z / z]_zs) #[(Y #[Z / z]_zs) / y]_ys)"
by (metis assms fresh freshEnv_getEnv freshEnv_getEnv2 freshEnv_idEnv freshEnv_updEnv_I idEnv_preserves_good psubst_subst_compose_freshEnv
subst_psubst_idEnv updEnv_preserves_good)
lemma substEnv_compose2:
assumes "goodEnv rho" and "good Y" and "good Z"
and "ys ≠ zs ∨ y ≠ z" and fresh: "fresh ys y Z"
shows "((rho &[Y / y]_ys) &[Z / z]_zs) = ((rho &[Z / z]_zs) &[(Y #[Z / z]_zs) / y]_ys)"
by (metis assms fresh freshEnv_updEnv_I getEnv_idEnv idEnv_preserves_good
option.discI psubstEnv_substEnv_compose_freshEnv substEnv_def
subst_psubst_idEnv updEnv_preserves_good)
lemma subst_vsubst_compose2:
assumes "good X" and "good Z"
and "ys ≠ zs ∨ y ≠ z" and fresh: "fresh ys y Z"
shows "((X #[y1 // y]_ys) #[Z / z]_zs) = ((X #[Z / z]_zs) #[((Var ys y1) #[Z / z]_zs) / y]_ys)"
using assms unfolding vsubst_def by(simp add: subst_compose2)
lemma substEnv_vsubstEnv_compose2:
assumes "goodEnv rho" and "good Z"
and "ys ≠ zs ∨ y ≠ z" and fresh: "fresh ys y Z"
shows "((rho &[y1 // y]_ys) &[Z / z]_zs) = ((rho &[Z / z]_zs) &[((Var ys y1) #[Z / z]_zs) / y]_ys)"
using assms unfolding vsubstEnv_def by(simp add: substEnv_compose2)
lemma vsubst_subst_compose2:
assumes "good X" and "good Y"
and "ys ≠ zs ∨ y ∉ {z,z1}"
shows "((X #[Y / y]_ys) #[z1 // z]_zs) = ((X #[z1 // z]_zs) #[(Y #[z1 // z]_zs) / y]_ys)"
using assms unfolding vsubst_def by(simp add: subst_compose2)
lemma vsubstEnv_substEnv_compose2:
assumes "goodEnv rho" and "good Y"
and "ys ≠ zs ∨ y ∉ {z,z1}"
shows "((rho &[Y / y]_ys) &[z1 // z]_zs) = ((rho &[z1 // z]_zs) &[(Y #[z1 // z]_zs) / y]_ys)"
using assms unfolding vsubst_def vsubstEnv_def by(simp add: substEnv_compose2)
lemma vsubst_compose2:
assumes "good X"
and "ys ≠ zs ∨ y ∉ {z,z1}"
shows "((X #[y1 // y]_ys) #[z1 // z]_zs) =
((X #[z1 // z]_zs) #[(y1 @ys[z1 / z]_zs) // y]_ys)"
by (metis vsubst_def Var_preserves_good assms vsubst_Var_simp vsubst_def
vsubst_subst_compose2)
lemma vsubstEnv_compose2:
assumes "goodEnv rho"
and "ys ≠ zs ∨ y ∉ {z,z1}"
shows "((rho &[y1 // y]_ys) &[z1 // z]_zs) =
((rho &[z1 // z]_zs) &[(y1 @ys[z1 / z]_zs) // y]_ys)"
by (metis Var_preserves_good assms
vsubstEnv_def vsubstEnv_substEnv_compose2 vsubst_Var_simp)
subsection ‹Properties specific to variable-for-variable substitution›
lemma vsubstAll_ident:
fixes X::"('index,'bindex,'varSort,'var,'opSym)term" and
A::"('index,'bindex,'varSort,'var,'opSym)abs" and
P::"('index,'bindex,'varSort,'var,'opSym)param" and zs
assumes P: "goodPar P"
shows
"(good X ⟶
(∀ z. z ∈ varsOf P ⟶ (X #[z // z]_zs) = X))
∧
(goodAbs A ⟶
(∀ z. z ∈ varsOf P ⟶ (A $[z // z]_zs) = A))"
proof(induct rule: term_induct_fresh[of P])
case (Op delta inp binp)
then show ?case
using assms
unfolding vsubst_def vsubstAbs_def liftAll_def lift_def
by simp (auto simp: lift_def substInp_def2 substBinp_def2 vsubstInp_def2
split: option.splits)
next
case (Abs xs x X)
then show ?case
by (metis empty_iff insert_iff vsubstAbs_simp)
qed(insert assms, simp_all)
corollary vsubst_ident[simp]:
assumes "good X"
shows "(X #[z // z]_zs) = X"
using assms vsubstAll_ident[of "Par [z] [] [] []" X]
unfolding goodPar_def by simp
corollary subst_ident[simp]:
assumes "good X"
shows "(X #[(Var zs z) / z]_zs) = X"
using assms vsubst_ident unfolding vsubst_def by auto
lemma vsubstAll_swapAll:
fixes X::"('index,'bindex,'varSort,'var,'opSym)term" and
A::"('index,'bindex,'varSort,'var,'opSym)abs" and
P::"('index,'bindex,'varSort,'var,'opSym)param" and ys
assumes P: "goodPar P"
shows
"(good X ⟶
(∀ y1 y2. {y1,y2} ⊆ varsOf P ∧ fresh ys y1 X ⟶
(X #[y1 // y2]_ys) = (X #[y1 ∧ y2]_ys)))
∧
(goodAbs A ⟶
(∀ y1 y2. {y1,y2} ⊆ varsOf P ∧ freshAbs ys y1 A ⟶
(A $[y1 // y2]_ys) = (A $[y1 ∧ y2]_ys)))"
apply(induction rule: term_induct_fresh[OF P])
subgoal by (force simp add: sw_def)
subgoal by simp (auto
simp: vsubstInp_def substInp_def2 vsubst_def swapInp_def
vsubstBinp_def substBinp_def2 vsubstAbs_def swapBinp_def
freshInp_def freshBinp_def lift_def liftAll_def
split: option.splits)
subgoal by simp (metis Var_preserves_good fresh_Var_simp substAbs_simp sw_def
vsubstAbs_def vsubst_def) .
corollary vsubst_eq_swap:
assumes "good X" and "y1 = y2 ∨ fresh ys y1 X"
shows "(X #[y1 // y2]_ys) = (X #[y1 ∧ y2]_ys)"
apply(cases "y1 = y2")
using assms vsubstAll_swapAll[of "Par [y1, y2] [] [] []" X]
unfolding goodPar_def by auto
lemma skelAll_vsubstAll:
fixes X::"('index,'bindex,'varSort,'var,'opSym)term" and
A::"('index,'bindex,'varSort,'var,'opSym)abs" and
P::"('index,'bindex,'varSort,'var,'opSym)param" and ys
assumes P: "goodPar P"
shows
"(good X ⟶
(∀ y1 y2. {y1,y2} ⊆ varsOf P ⟶
skel (X #[y1 // y2]_ys) = skel X))
∧
(goodAbs A ⟶
(∀ y1 y2. {y1,y2} ⊆ varsOf P ⟶
skelAbs (A $[y1 // y2]_ys) = skelAbs A))"
proof(induction rule: term_induct_fresh[of P])
case (Op delta inp binp)
then show ?case
by (simp add: skelInp_def2 skelBinp_def2)
(auto simp: vsubst_def vsubstInp_def substInp_def2
vsubstAbs_def vsubstBinp_def substBinp_def2 lift_def liftAll_def
split: option.splits)
next
case (Abs xs x X)
then show ?case using assms
by simp (metis not_equals_and_not_equals_not_in
skelAbs_simp vsubstAbs_simp vsubst_preserves_good)
qed(insert assms, simp_all)
corollary skel_vsubst:
assumes "good X"
shows "skel (X #[y1 // y2]_ys) = skel X"
using assms skelAll_vsubstAll[of "Par [y1, y2] [] [] []" X]
unfolding goodPar_def by simp
lemma subst_vsubst_trans:
assumes "good X" and "good Y" and "fresh ys y1 X"
shows "((X #[y1 // y]_ys) #[Y / y1]_ys) = (X #[Y / y]_ys)"
using assms unfolding subst_def vsubst_def
by (cases "y1 = y") (simp_all add: fresh_psubst_updEnv psubstEnv_updEnv_idEnv
psubst_compose updEnv_commute)
lemma vsubst_trans:
assumes "good X" and "fresh ys y1 X"
shows "((X #[y1 // y]_ys) #[y2 // y1]_ys) = (X #[y2 // y]_ys)"
unfolding vsubst_def[of _ y2 y1] vsubst_def[of _ y2 y]
using assms by(simp add: subst_vsubst_trans)
lemma vsubst_commute:
assumes X: "good X"
and "xs ≠ xs' ∨ {x,y} ∩ {x',y'} = {}" and "fresh xs x X" and "fresh xs' x' X"
shows "((X #[x // y]_xs) #[x' // y']_xs') = ((X #[x' // y']_xs') #[x // y]_xs)"
proof-
have "fresh xs' x' (X #[x // y]_xs)"
using assms by (intro vsubst_preserves_fresh) auto
moreover have "fresh xs x (X #[x' // y']_xs')"
using assms by (intro vsubst_preserves_fresh) auto
ultimately show ?thesis using assms
by (auto simp: vsubst_eq_swap intro!: swap_commute)
qed
subsection ‹Abstraction versions of the properties›
text‹Environment identity and update versus other operators:›
lemma psubstAbs_idEnv[simp]:
"goodAbs A ⟹ (A $[idEnv]) = A"
by(simp add: psubstAll_idEnv)
text‹Substitution versus other operators:›
corollary freshAbs_psubstAbs:
assumes "goodAbs A" and "goodEnv rho"
shows
"freshAbs zs z (A $[rho]) =
(∀ ys y. freshAbs ys y A ∨ freshImEnvAt zs z rho ys y)"
using assms freshAll_psubstAll[of "Par [z] [] [] [rho]"]
unfolding goodPar_def by simp
corollary freshAbs_psubstAbs_E1:
assumes "goodAbs A" and "goodEnv rho"
and "rho ys y = None" and "freshAbs zs z (A $[rho])"
shows "freshAbs ys y A ∨ (ys ≠ zs ∨ y ≠ z)"
using assms freshAbs_psubstAbs unfolding freshImEnvAt_def by fastforce
corollary freshAbs_psubstAbs_E2:
assumes "goodAbs A" and "goodEnv rho"
and "rho ys y = Some Y" and "freshAbs zs z (A $[rho])"
shows "freshAbs ys y A ∨ fresh zs z Y"
using assms freshAbs_psubstAbs[of A rho] unfolding freshImEnvAt_def by fastforce
corollary freshAbs_psubstAbs_I1:
assumes "goodAbs A" and "goodEnv rho"
and "freshAbs zs z A" and "freshEnv zs z rho"
shows "freshAbs zs z (A $[rho])"
using assms apply(simp add: freshAbs_psubstAbs)
unfolding freshEnv_def liftAll_def freshImEnvAt_def by auto
corollary freshAbs_psubstAbs_I:
assumes "goodAbs A" and "goodEnv rho"
and "rho zs z = None ⟹ freshAbs zs z A" and
"⋀ ys y Y. rho ys y = Some Y ⟹ freshAbs ys y A ∨ fresh zs z Y"
shows "freshAbs zs z (A $[rho])"
using assms using option.exhaust_sel
by (simp add: freshAbs_psubstAbs freshImEnvAt_def) blast
lemma freshAbs_substAbs:
assumes "goodAbs A" and "good Y"
shows "freshAbs zs z (A $[Y / y]_ys) =
(((zs = ys ∧ z = y) ∨ freshAbs zs z A) ∧ (freshAbs ys y A ∨ fresh zs z Y))"
unfolding substAbs_def using assms
by (auto simp: freshAbs_psubstAbs freshImEnvAt_def)
lemma freshAbs_vsubstAbs:
assumes "goodAbs A"
shows "freshAbs zs z (A $[y1 // y]_ys) =
(((zs = ys ∧ z = y) ∨ freshAbs zs z A) ∧
(freshAbs ys y A ∨ (zs ≠ ys ∨ z ≠ y1)))"
unfolding vsubstAbs_def using assms by(auto simp: freshAbs_substAbs)
lemma substAbs_preserves_freshAbs:
assumes "goodAbs A" and "good Y"
and "freshAbs zs z A" and "fresh zs z Y"
shows "freshAbs zs z (A $[Y / y]_ys)"
using assms by(simp add: freshAbs_substAbs)
lemma vsubstAbs_preserves_freshAbs:
assumes "goodAbs A"
and "freshAbs zs z A" and "zs ≠ ys ∨ z ≠ y1"
shows "freshAbs zs z (A $[y1 // y]_ys)"
using assms by(simp add: freshAbs_vsubstAbs)
lemma fresh_freshAbs_substAbs[simp]:
assumes "good Y" and "goodAbs A"
and "fresh ys y Y"
shows "freshAbs ys y (A $[Y / y]_ys)"
using assms by(simp add: freshAbs_substAbs)
lemma diff_freshAbs_vsubstAbs[simp]:
assumes "goodAbs A"
and "y ≠ y1"
shows "freshAbs ys y (A $[y1 // y]_ys)"
using assms by(simp add: freshAbs_vsubstAbs)
lemma freshAbs_substAbs_E1:
assumes "goodAbs A" and "good Y"
and "freshAbs zs z (A $[Y / y]_ys)" and "zs ≠ ys ∨ z ≠ y"
shows "freshAbs zs z A"
using assms by(auto simp: freshAbs_substAbs)
lemma freshAbs_vsubstAbs_E1:
assumes "goodAbs A"
and "freshAbs zs z (A $[y1 // y]_ys)" and "zs ≠ ys ∨ z ≠ y"
shows "freshAbs zs z A"
using assms by(auto simp: freshAbs_vsubstAbs)
lemma freshAbs_substAbs_E2:
assumes "goodAbs A" and "good Y"
and "freshAbs zs z (A $[Y / y]_ys)"
shows "freshAbs ys y A ∨ fresh zs z Y"
using assms by(simp add: freshAbs_substAbs)
lemma freshAbs_vsubstAbs_E2:
assumes "goodAbs A"
and "freshAbs zs z (A $[y1 // y]_ys)"
shows "freshAbs ys y A ∨ zs ≠ ys ∨ z ≠ y1"
using assms by(simp add: freshAbs_vsubstAbs)
corollary psubstAbs_cong[fundef_cong]:
assumes "goodAbs A" and "goodEnv rho" and "goodEnv rho'"
and "⋀ ys y. freshAbs ys y A ∨ rho ys y = rho' ys y"
shows "(A $[rho]) = (A $[rho'])"
using assms psubstAll_cong[of "Par [] [] [] [rho,rho']"]
unfolding goodPar_def by simp
lemma freshAbs_psubstAbs_updEnv:
assumes "good X" and "goodAbs A" and "goodEnv rho"
and "freshAbs xs x A"
shows "(A $[rho [x ← X]_xs]) = (A $[rho])"
using assms by (intro psubstAbs_cong) auto
corollary freshEnv_psubstAbs_ident[simp]:
fixes A :: "('index,'bindex,'varSort,'var,'opSym)abs"
assumes "goodAbs A" and "goodEnv rho"
and "⋀ zs z. freshEnv zs z rho ∨ freshAbs zs z A"
shows "(A $[rho]) = A"
using assms psubstAll_ident[of "Par [] [] [] [rho]"]
unfolding goodPar_def by simp
lemma freshAbs_substAbs_ident[simp]:
assumes "good X" and "goodAbs A" and "freshAbs xs x A"
shows "(A $[X / x]_xs) = A"
by (simp add: assms freshAbs_psubstAbs_updEnv substAbs_def)
corollary substAbs_Abs[simp]:
assumes "good X" and "good Y"
shows "((Abs xs x X) $[Y / x]_xs) = Abs xs x X"
using assms by simp
lemma freshAbs_vsubstAbs_ident[simp]:
assumes "goodAbs A" and "freshAbs xs x A"
shows "(A $[x1 // x]_xs) = A"
using assms unfolding vsubstAbs_def by(auto simp: freshAbs_substAbs_ident)
lemma swapAbs_psubstAbs:
assumes "goodAbs A" and "goodEnv rho"
shows "((A $[rho]) $[z1 ∧ z2]_zs) = ((A $[z1 ∧ z2]_zs) $[rho &[z1 ∧ z2]_zs])"
using assms swapAll_psubstAll[of "Par [z1,z2] [] [] [rho]"]
unfolding goodPar_def by auto
lemma swapAbs_substAbs:
assumes "goodAbs A" and "good Y"
shows "((A $[Y / y]_ys) $[z1 ∧ z2]_zs) =
((A $[z1 ∧ z2]_zs) $[(Y #[z1 ∧ z2]_zs) / (y @ys[z1 ∧ z2]_zs)]_ys)"
proof-
have 1: "(idEnv [(y @ys[z1 ∧ z2]_zs) ← (Y #[z1 ∧ z2]_zs)]_ys) =
((idEnv [y ← Y]_ys) &[z1 ∧ z2]_zs)"
by(simp add: swapEnv_updEnv)
show ?thesis
unfolding substAbs_def 1 using assms by (intro swapAbs_psubstAbs) auto
qed
lemma swapAbs_vsubstAbs:
assumes "goodAbs A"
shows "((A $[y1 // y]_ys) $[z1 ∧ z2]_zs) =
((A $[z1 ∧ z2]_zs) $[(y1 @ys[z1 ∧ z2]_zs) // (y @ys[z1 ∧ z2]_zs)]_ys)"
using assms unfolding vsubstAbs_def
by(simp add: swapAbs_substAbs)
lemma psubstAbs_compose:
assumes "goodAbs A" and "goodEnv rho" and "goodEnv rho'"
shows "((A $[rho]) $[rho']) = (A $[(rho &[rho'])])"
using assms psubstAll_compose[of "Par [] [] [] [rho, rho']"]
unfolding goodPar_def by auto
lemma psubstAbs_substAbs_compose:
assumes "goodAbs A" and "good Y" and "goodEnv rho"
shows "((A $[Y / y]_ys) $[rho]) = (A $[(rho [y ← (Y #[rho])]_ys)])"
by (simp add: assms psubstAbs_compose psubstEnv_updEnv_idEnv substAbs_def)
lemma psubstAbs_vsubstAbs_compose:
assumes "goodAbs A" and "goodEnv rho"
shows "((A $[y1 // y]_ys) $[rho]) = (A $[(rho [y ← ((Var ys y1) #[rho])]_ys)])"
using assms unfolding vsubstAbs_def by(simp add: psubstAbs_substAbs_compose)
lemma substAbs_psubstAbs_compose:
assumes "goodAbs A" and "good Y" and "goodEnv rho"
shows "((A $[rho]) $[Y / y]_ys) = (A $[(rho &[Y / y]_ys)])"
unfolding substAbs_def substEnv_def using assms by(simp add: psubstAbs_compose)
lemma psubstAbs_substAbs_compose_freshEnv:
assumes "goodAbs A" and "goodEnv rho" and "good Y"
assumes "freshEnv ys y rho"
shows "((A $[Y / y]_ys) $[rho]) = ((A $[rho]) $[(Y #[rho]) / y]_ys)"
using assms by (simp add: substAbs_psubstAbs_compose psubstAbs_substAbs_compose)
lemma vsubstAbs_psubstAbs_compose:
assumes "goodAbs A" and "goodEnv rho"
shows "((A $[rho]) $[y1 // y]_ys) = (A $[(rho &[y1 // y]_ys)])"
unfolding vsubstAbs_def vsubstEnv_def using assms
by(simp add: substAbs_psubstAbs_compose)
lemma substAbs_compose1:
assumes "goodAbs A" and "good Y1" and "good Y2"
shows "((A $[Y1 / y]_ys) $[Y2 / y]_ys) = (A $[(Y1 #[Y2 / y]_ys) / y]_ys)"
by (metis assms idEnv_preserves_good psubstAbs_substAbs_compose substAbs_def
subst_psubst_idEnv updEnv_overwrite updEnv_preserves_good)
lemma substAbs_vsubstAbs_compose1:
assumes "goodAbs A" and "good Y" and "y ≠ y1"
shows "((A $[y1 // y]_ys) $[Y / y]_ys) = (A $[y1 // y]_ys)"
using assms unfolding vsubstAbs_def by(simp add: substAbs_compose1)
lemma vsubstAbs_substAbs_compose1:
assumes "goodAbs A" and "good Y"
shows "((A $[Y / y]_ys) $[y1 // y]_ys) = (A $[(Y #[y1 // y]_ys) / y]_ys)"
using assms unfolding vsubstAbs_def vsubst_def by(simp add: substAbs_compose1)
lemma vsubstAbs_compose1:
assumes "goodAbs A"
shows "((A $[y1 // y]_ys) $[y2 // y]_ys) = (A $[(y1 @ys[y2 / y]_ys) // y]_ys)"
using assms unfolding vsubstAbs_def
by(cases "y = y1") (auto simp: substAbs_compose1)
lemma substAbs_compose2:
assumes "goodAbs A" and "good Y" and "good Z"
and "ys ≠ zs ∨ y ≠ z" and fresh: "fresh ys y Z"
shows "((A $[Y / y]_ys) $[Z / z]_zs) = ((A $[Z / z]_zs) $[(Y #[Z / z]_zs) / y]_ys)"
by (metis assms fresh freshEnv_idEnv idEnv_preserves_good
psubstAbs_substAbs_compose_freshEnv substAbs_def
substEnv_idEnv substEnv_preserves_freshEnv_aux
subst_psubst_idEnv updEnv_preserves_good)
lemma substAbs_vsubstAbs_compose2:
assumes "goodAbs A" and "good Z"
and "ys ≠ zs ∨ y ≠ z" and fresh: "fresh ys y Z"
shows "((A $[y1 // y]_ys) $[Z / z]_zs) = ((A $[Z / z]_zs) $[((Var ys y1) #[Z / z]_zs) / y]_ys)"
using assms unfolding vsubstAbs_def by(simp add: substAbs_compose2)
lemma vsubstAbs_substAbs_compose2:
assumes "goodAbs A" and "good Y"
and "ys ≠ zs ∨ y ∉ {z,z1}"
shows "((A $[Y / y]_ys) $[z1 // z]_zs) = ((A $[z1 // z]_zs) $[(Y #[z1 // z]_zs) / y]_ys)"
using assms unfolding vsubstAbs_def vsubst_def by(simp add: substAbs_compose2)
lemma vsubstAbs_compose2:
assumes "goodAbs A"
and "ys ≠ zs ∨ y ∉ {z,z1}"
shows "((A $[y1 // y]_ys) $[z1 // z]_zs) =
((A $[z1 // z]_zs) $[(y1 @ys[z1 / z]_zs) // y]_ys)"
unfolding vsubstAbs_def
by (smt Var_preserves_good assms fresh_Var_simp insertCI
substAbs_compose2 vsubst_Var_simp vsubst_def)
text‹Properties specific to variable-for-variable substitution:›
corollary vsubstAbs_ident[simp]:
assumes "goodAbs A"
shows "(A $[z // z]_zs) = A"
using assms vsubstAll_ident[of "Par [z] [] [] []" _ _ A]
unfolding goodPar_def by simp
corollary substAbs_ident[simp]:
assumes "goodAbs A"
shows "(A $[(Var zs z) / z]_zs) = A"
using assms vsubstAbs_ident unfolding vsubstAbs_def by auto
corollary vsubstAbs_eq_swapAbs:
assumes "goodAbs A" and "freshAbs ys y1 A"
shows "(A $[y1 // y2]_ys) = (A $[y1 ∧ y2]_ys)"
using assms vsubstAll_swapAll[of "Par [y1, y2] [] [] []" _ _ A]
unfolding goodPar_def by simp
corollary skelAbs_vsubstAbs:
assumes "goodAbs A"
shows "skelAbs (A $[y1 // y2]_ys) = skelAbs A"
using assms skelAll_vsubstAll[of "Par [y1, y2] [] [] []" _ _ A]
unfolding goodPar_def by simp
lemma substAbs_vsubstAbs_trans:
assumes "goodAbs A" and "good Y" and "freshAbs ys y1 A"
shows "((A $[y1 // y]_ys) $[Y / y1]_ys) = (A $[Y / y]_ys)"
using assms unfolding substAbs_def vsubstAbs_def
by (cases "y1 = y") (auto simp: freshAbs_psubstAbs_updEnv psubstAbs_compose
psubstEnv_updEnv_idEnv updEnv_commute)
lemma vsubstAbs_trans:
assumes "goodAbs A" and "freshAbs ys y1 A"
shows "((A $[y1 // y]_ys) $[y2 // y1]_ys) = (A $[y2 // y]_ys)"
unfolding vsubstAbs_def[of _ y2 y1] vsubstAbs_def[of _ y2 y]
using assms by(simp add: substAbs_vsubstAbs_trans)
lemmas good_psubstAll_freshAll_otherSimps =
psubst_idEnv psubstEnv_idEnv_id psubstAbs_idEnv
freshEnv_psubst_ident freshEnv_psubstAbs_ident
lemmas good_substAll_freshAll_otherSimps =
fresh_fresh_subst fresh_subst_ident fresh_substEnv_updEnv subst_ident
fresh_freshAbs_substAbs freshAbs_substAbs_ident substAbs_ident
lemmas good_vsubstAll_freshAll_otherSimps =
diff_fresh_vsubst fresh_vsubst_ident fresh_vsubstEnv_updEnv vsubst_ident
diff_freshAbs_vsubstAbs freshAbs_vsubstAbs_ident vsubstAbs_ident
lemmas good_allOpers_otherSimps =
good_swapAll_freshAll_otherSimps
good_psubstAll_freshAll_otherSimps
good_substAll_freshAll_otherSimps
good_vsubstAll_freshAll_otherSimps
lemmas good_item_simps =
param_simps
all_preserve_good
good_freeCons
good_allOpers_simps
good_allOpers_otherSimps
end
end
Theory Well_Sorted_Terms
section ‹Binding Signatures and well-sorted terms›
theory Well_Sorted_Terms
imports Terms
begin
text ‹This section introduces binding signatures
and well-sorted terms for them. All the properties we proved for good terms are then
lifted to well-sorted terms.
›
subsection ‹Binding signatures›
text‹A {\em (binding) signature} consists of:
\\- an indication of which sorts of variables can be injected in
which sorts of terms;
\\- for any operation symbol, dwelling in a type ``opSym",
an indication of its result sort, its (nonbinding) arity, and its binding arity.
In addition, we have a predicate, ``wlsOpSym", that specifies which operations symbols
are well-sorted (or well-structured)
\footnote
{
We shall use ``wls" in many contexts as a prefix indicating well-sortedness or
well-structuredness.
}
-- only these operation symbols will be considered in
forming terms. In other words, the relevant collection of operation symbols is given not by the
whole type ``opSym", but by the predicate ``wlsOpSym". This bit of extra flexibility
will be useful when (pre)instantiating the signature to concrete syntaxes.
(Note that the ``wlsOpSym" condition will be required for well-sorted terms as part of the notion of
well-sorted (free and bound) input, ``wlsInp" and ``wlsBinp".)
›
record ('index,'bindex,'varSort,'sort,'opSym)signature =
varSortAsSort :: "'varSort ⇒ 'sort"
wlsOpSym :: "'opSym ⇒ bool"
sortOf :: "'opSym ⇒ 'sort"
arityOf :: "'opSym ⇒ ('index, 'sort)input"
barityOf :: "'opSym ⇒ ('bindex, 'varSort * 'sort)input"
subsection ‹The Binding Syntax locale›
text ‹For our signatures, we shall make some assumptions:
\\- For each sort of term, there is at most one sort of variables injectable
in terms of that sort (i.e., ``varSortAsSort" is injective");
\\- The domains of arities (sets of indexes) are smaller than the set of variables
of each sort;
\\- The type of sorts is smaller than the set of variables
of each sort.
These are satisfiable assumptions, and in particular they are trivially satisfied by any finitary syntax
with bindings.
›
definition varSortAsSort_inj where
"varSortAsSort_inj Delta ==
inj (varSortAsSort Delta)"
definition arityOf_lt_var where
"arityOf_lt_var (_ :: 'var) Delta ==
∀ delta.
wlsOpSym Delta delta ⟶ |{i. arityOf Delta delta i ≠ None}| <o |UNIV :: 'var set|"
definition barityOf_lt_var where
"barityOf_lt_var (_ :: 'var) Delta ==
∀ delta.
wlsOpSym Delta delta ⟶ |{i. barityOf Delta delta i ≠ None}| <o |UNIV :: 'var set|"
definition sort_lt_var where
"sort_lt_var (_ :: 'sort) (_ :: 'var) ==
|UNIV :: 'sort set| <o |UNIV :: 'var set|"
locale FixSyn =
fixes dummyV :: 'var
and Delta :: "('index,'bindex,'varSort,'sort,'opSym)signature"
assumes
FixSyn_var_infinite: "var_infinite (undefined :: 'var)"
and FixSyn_var_regular: "var_regular (undefined :: 'var)"
and varSortAsSort_inj: "varSortAsSort_inj Delta"
and arityOf_lt_var: "arityOf_lt_var (undefined :: 'var) Delta"
and barityOf_lt_var: "barityOf_lt_var (undefined :: 'var) Delta"
and sort_lt_var: "sort_lt_var (undefined :: 'sort) (undefined :: 'var)"
context FixSyn
begin
lemmas FixSyn_assms =
FixSyn_var_infinite FixSyn_var_regular
varSortAsSort_inj arityOf_lt_var barityOf_lt_var
sort_lt_var
end
subsection ‹Definitions and basic properties of well-sortedness›
subsubsection ‹Notations and definitions›
datatype ('index,'bindex,'varSort,'var,'opSym,'sort)paramS =
ParS "'varSort ⇒ 'var list"
"'sort ⇒ ('index,'bindex,'varSort,'var,'opSym)term list"
"('varSort * 'sort) ⇒ ('index,'bindex,'varSort,'var,'opSym)abs list"
"('index,'bindex,'varSort,'var,'opSym)env list"
fun varsOfS ::
"('index,'bindex,'varSort,'var,'opSym,'sort)paramS ⇒ 'varSort ⇒ 'var set"
where "varsOfS (ParS xLF _ _ _) xs = set (xLF xs)"
fun termsOfS ::
"('index,'bindex,'varSort,'var,'opSym,'sort)paramS ⇒
'sort ⇒ ('index,'bindex,'varSort,'var,'opSym)term set"
where "termsOfS (ParS _ XLF _ _) s = set (XLF s)"
fun absOfS ::
"('index,'bindex,'varSort,'var,'opSym,'sort)paramS ⇒
('varSort * 'sort) ⇒ ('index,'bindex,'varSort,'var,'opSym)abs set"
where "absOfS (ParS _ _ ALF _) (xs,s) = set (ALF (xs,s))"
fun envsOfS ::
"('index,'bindex,'varSort,'var,'opSym,'sort)paramS ⇒ ('index,'bindex,'varSort,'var,'opSym)env set"
where "envsOfS (ParS _ _ _ rhoL) = set rhoL"
subsubsection ‹Sublocale of ``FixVars"›
lemma sort_lt_var_imp_varSort_lt_var:
assumes
**: "varSortAsSort_inj (Delta :: ('index,'bindex,'varSort,'sort,'opSym)signature)"
and ***: "sort_lt_var (undefined :: 'sort) (undefined :: 'var)"
shows "varSort_lt_var (undefined :: 'varSort) (undefined :: 'var)"
proof-
have "|UNIV::'varSort set| ≤o |UNIV::'sort set|"
using card_of_ordLeq ** unfolding varSortAsSort_inj_def by auto
thus ?thesis
using ordLeq_ordLess_trans assms
unfolding sort_lt_var_def varSort_lt_var_def by blast
qed
sublocale FixSyn < FixVars
where dummyV = dummyV and dummyVS = "undefined::'varSort"
using FixSyn_assms
by unfold_locales (auto simp add: sort_lt_var_imp_varSort_lt_var)
subsubsection ‹Abbreviations›
context FixSyn
begin
abbreviation asSort where "asSort == varSortAsSort Delta"
abbreviation wlsOpS where "wlsOpS == wlsOpSym Delta"
abbreviation stOf where "stOf == sortOf Delta"
abbreviation arOf where "arOf == arityOf Delta"
abbreviation barOf where "barOf == barityOf Delta"
abbreviation empInp ::
"('index,('index,'bindex,'varSort,'var,'opSym)term)input"
where "empInp == λi. None"
abbreviation empAr :: "('index,'sort)input"
where "empAr == λi. None"
abbreviation empBinp :: "('bindex,('index,'bindex,'varSort,'var,'opSym)abs)input"
where "empBinp == λi. None"
abbreviation empBar :: "('bindex,'varSort * 'sort)input"
where "empBar == λi. None"
lemma freshInp_empInp[simp]:
"freshInp xs x empInp"
unfolding freshInp_def liftAll_def by simp
lemma swapInp_empInp[simp]:
"(empInp %[x1 ∧ x2]_xs) = empInp"
unfolding swapInp_def lift_def by simp
lemma psubstInp_empInp[simp]:
"(empInp %[rho]) = empInp"
unfolding psubstInp_def lift_def by simp
lemma substInp_empInp[simp]:
"(empInp %[Y / y]_ys) = empInp"
unfolding substInp_def by simp
lemma vsubstInp_empInp[simp]:
"(empInp %[y1 // y]_ys) = empInp"
unfolding vsubstInp_def by simp
lemma freshBinp_empBinp[simp]:
"freshBinp xs x empBinp"
unfolding freshBinp_def liftAll_def by simp
lemma swapBinp_empBinp[simp]:
"(empBinp %%[x1 ∧ x2]_xs) = empBinp"
unfolding swapBinp_def lift_def by simp
lemma psubstBinp_empBinp[simp]:
"(empBinp %%[rho]) = empBinp"
unfolding psubstBinp_def lift_def by simp
lemma substBinp_empBinp[simp]:
"(empBinp %%[Y / y]_ys) = empBinp"
unfolding substBinp_def by simp
lemma vsubstBinp_empBinp[simp]:
"(empBinp %%[y1 // y]_ys) = empBinp"
unfolding vsubstBinp_def by simp
lemmas empInp_simps =
freshInp_empInp swapInp_empInp psubstInp_empInp substInp_empInp vsubstInp_empInp
freshBinp_empBinp swapBinp_empBinp psubstBinp_empBinp substBinp_empBinp vsubstBinp_empBinp
subsubsection ‹Inner versions of the locale assumptions›
lemma varSortAsSort_inj_INNER: "inj asSort"
using varSortAsSort_inj
unfolding varSortAsSort_inj_def by simp
lemma asSort_inj[simp]:
"(asSort xs = asSort ys) = (xs = ys)"
using varSortAsSort_inj_INNER unfolding inj_on_def by auto
lemma arityOf_lt_var_INNER:
assumes "wlsOpS delta"
shows "|{i. arityOf Delta delta i ≠ None}| <o |UNIV :: 'var set|"
using assms arityOf_lt_var unfolding arityOf_lt_var_def by simp
lemma barityOf_lt_var_INNER:
assumes "wlsOpS delta"
shows "|{i. barityOf Delta delta i ≠ None}| <o |UNIV :: 'var set|"
using assms barityOf_lt_var unfolding barityOf_lt_var_def by simp
lemma sort_lt_var_INNER:
"|UNIV :: 'sort set| <o |UNIV :: 'var set|"
using sort_lt_var unfolding sort_lt_var_def by simp
lemma sort_le_var:
"|UNIV :: 'sort set| ≤o |UNIV :: 'var set|"
using sort_lt_var_INNER ordLess_imp_ordLeq by auto
lemma varSort_sort_lt_var:
"|UNIV :: ('varSort * 'sort) set| <o |UNIV :: 'var set|"
unfolding UNIV_Times_UNIV[symmetric]
using var_infinite_INNER varSort_lt_var_INNER sort_lt_var_INNER
by(rule card_of_Times_ordLess_infinite)
lemma varSort_sort_le_var:
"|UNIV :: ('varSort * 'sort) set| ≤o |UNIV :: 'var set|"
using varSort_sort_lt_var ordLess_imp_ordLeq by auto
subsubsection ‹Definitions of well-sorted items›
text ‹We shall only be interested in abstractions that pertain to some bound arities:›
definition isInBar where
"isInBar xs_s ==
∃ delta i. wlsOpS delta ∧ barOf delta i = Some xs_s"
text ‹Well-sorted terms (according to the signature) are defined as expected (mutually inductively
together with well-sorted abstractions and inputs):›
inductive
wls :: "'sort ⇒ ('index,'bindex,'varSort,'var,'opSym)term ⇒ bool"
and
wlsAbs :: "'varSort * 'sort ⇒ ('index,'bindex,'varSort,'var,'opSym)abs ⇒ bool"
and
wlsInp :: "'opSym ⇒ ('index,('index,'bindex,'varSort,'var,'opSym)term)input ⇒ bool"
and
wlsBinp :: "'opSym ⇒ ('bindex,('index,'bindex,'varSort,'var,'opSym)abs)input ⇒ bool"
where
Var: "wls (asSort xs) (Var xs x)"
|
Op: "⟦wlsInp delta inp; wlsBinp delta binp⟧ ⟹ wls (stOf delta) (Op delta inp binp)"
|
Inp:
"⟦wlsOpS delta;
⋀ i. (arOf delta i = None ∧ inp i = None) ∨
(∃ s X. arOf delta i = Some s ∧ inp i = Some X ∧ wls s X)⟧
⟹ wlsInp delta inp"
|
Binp:
"⟦wlsOpS delta;
⋀ i. (barOf delta i = None ∧ binp i = None) ∨
(∃ us s A. barOf delta i = Some (us,s) ∧ binp i = Some A ∧ wlsAbs (us,s) A)⟧
⟹ wlsBinp delta binp"
|
Abs: "⟦isInBar (xs,s); wls s X⟧ ⟹ wlsAbs (xs,s) (Abs xs x X)"
lemmas Var_preserves_wls = wls_wlsAbs_wlsInp_wlsBinp.Var
lemmas Op_preserves_wls = wls_wlsAbs_wlsInp_wlsBinp.Op
lemmas Abs_preserves_wls = wls_wlsAbs_wlsInp_wlsBinp.Abs
lemma barOf_isInBar[simp]:
assumes "wlsOpS delta" and "barOf delta i = Some (us,s)"
shows "isInBar (us,s)"
unfolding isInBar_def using assms by blast
lemmas Cons_preserve_wls =
barOf_isInBar
Var_preserves_wls Op_preserves_wls
Abs_preserves_wls
declare Cons_preserve_wls [simp]
definition wlsEnv :: "('index,'bindex,'varSort,'var,'opSym)env ⇒ bool"
where
"wlsEnv rho ==
(∀ ys. liftAll (wls (asSort ys)) (rho ys)) ∧
(∀ ys. |{y. rho ys y ≠ None}| <o |UNIV :: 'var set| )"
definition wlsPar :: "('index,'bindex,'varSort,'var,'opSym,'sort)paramS ⇒ bool"
where
"wlsPar P ==
(∀ s. ∀ X ∈ termsOfS P s. wls s X) ∧
(∀ xs s. ∀ A ∈ absOfS P (xs,s). wlsAbs (xs,s) A) ∧
(∀ rho ∈ envsOfS P. wlsEnv rho)"
lemma ParS_preserves_wls[simp]:
assumes "⋀ s X. X ∈ set (XLF s) ⟹ wls s X"
and "⋀ xs s A. A ∈ set (ALF (xs,s)) ⟹ wlsAbs (xs,s) A"
and "⋀ rho. rho ∈ set rhoF ⟹ wlsEnv rho"
shows "wlsPar (ParS xLF XLF ALF rhoF)"
using assms unfolding wlsPar_def by auto
lemma termsOfS_preserves_wls[simp]:
assumes "wlsPar P" and "X : termsOfS P s"
shows "wls s X"
using assms unfolding wlsPar_def by auto
lemma absOfS_preserves_wls[simp]:
assumes "wlsPar P" and "A : absOfS P (us,s)"
shows "wlsAbs (us,s) A"
using assms unfolding wlsPar_def by auto
lemma envsOfS_preserves_wls[simp]:
assumes "wlsPar P" and "rho : envsOfS P "
shows "wlsEnv rho"
using assms unfolding wlsPar_def by blast
lemma not_isInBar_absOfS_empty[simp]:
assumes *: "¬ isInBar (us,s)" and **: "wlsPar P"
shows "absOfS P (us,s) = {}"
proof-
{fix A assume "A : absOfS P (us,s)"
hence "wlsAbs (us,s) A" using ** by simp
hence False using * using wlsAbs.cases by auto
}
thus ?thesis by auto
qed
lemmas paramS_simps =
varsOfS.simps termsOfS.simps absOfS.simps envsOfS.simps
ParS_preserves_wls
termsOfS_preserves_wls absOfS_preserves_wls envsOfS_preserves_wls
not_isInBar_absOfS_empty
subsubsection ‹Well-sorted exists›
lemma wlsInp_iff:
"wlsInp delta inp =
(wlsOpS delta ∧ sameDom (arOf delta) inp ∧ liftAll2 wls (arOf delta) inp)"
by (simp add: wlsInp.simps wls_wlsAbs_wlsInp_wlsBinp.Inp sameDom_and_liftAll2_iff)
lemma wlsBinp_iff:
"wlsBinp delta binp =
(wlsOpS delta ∧ sameDom (barOf delta) binp ∧ liftAll2 wlsAbs (barOf delta) binp)"
by (simp add: wlsBinp.simps wls_wlsAbs_wlsInp_wlsBinp.Inp sameDom_and_liftAll2_iff)
lemma exists_asSort_wls:
"∃ X. wls (asSort xs) X"
by (intro exI[of _ "Var xs undefined"]) simp
lemma exists_wls_imp_exists_wlsAbs:
assumes *: "isInBar (us,s)" and **: "∃ X. wls s X"
shows "∃ A. wlsAbs (us,s) A"
proof-
obtain X where "wls s X" using ** by blast
hence "wlsAbs (us,s) (Abs us undefined X)" using * by simp
thus ?thesis by blast
qed
lemma exists_asSort_wlsAbs:
assumes "isInBar (us,asSort xs)"
shows "∃ A. wlsAbs (us,asSort xs) A"
proof-
obtain X where "wls (asSort xs) X" using exists_asSort_wls by auto
thus ?thesis using assms exists_wls_imp_exists_wlsAbs by auto
qed
text ‹Standard criterion for the non-emptiness of the sets of well-sorted terms for each sort,
by a well-founded relation and a function picking, for sorts not corresponding to varSorts,
an operation symbol as an ``inductive" witness for non-emptyness.
``witOpS" stands for ``witness operation symbol".›
definition witOpS where
"witOpS s delta R ==
wlsOpS delta ∧ stOf delta = s ∧
liftAll (λs'. (s',s) : R) (arOf delta) ∧
liftAll (λ(us,s'). (s',s) : R) (barOf delta)"
lemma wf_exists_wls:
assumes wf: "wf R" and *: "⋀s. (∃ xs. s = asSort xs) ∨ witOpS s (f s) R"
shows "∃ X. wls s X"
proof(induction rule: wf_induct[of R])
case (2 s)
show ?case
proof(cases "∃ xs. s = asSort xs")
case True
thus ?thesis using exists_asSort_wls by auto
next
let ?delta = "f s"
case False
hence delta: "wlsOpS ?delta" and st: "stOf ?delta = s"
and ar: "liftAll (λs'. (s',s) : R) (arOf ?delta)"
and bar: "liftAll (λ(us,s'). (s',s) : R) (barOf ?delta)"
using * unfolding witOpS_def by auto
have 1: "∀ i s'. arOf ?delta i = Some s' ⟶ (∃ X. wls s' X)"
using ar 2 unfolding liftAll_def by simp
let ?chi = "λi s' X. arOf ?delta i = Some s' ⟶ wls s' X"
define inp where
"inp ≡ (λi. (if arOf ?delta i = None
then None
else Some (SOME X. ∀ s'. ?chi i s' X)))"
have inp: "wlsInp ?delta inp"
unfolding wlsInp_iff sameDom_def liftAll2_def using delta
by (auto simp: inp_def 1 someI2_ex split: if_splits)
have 1: "∀ i us s'. barOf ?delta i = Some (us,s') ⟶ (∃ A. wlsAbs (us,s') A)"
using bar 2 unfolding liftAll_def using delta exists_wls_imp_exists_wlsAbs by simp
let ?chi = "λi us s' A. barOf ?delta i = Some (us,s') ⟶ wlsAbs (us,s') A"
define binp where
"binp ≡ (λi. (if barOf ?delta i = None
then None
else Some (SOME A. ∀ us s'. ?chi i us s' A)))"
have binp: "wlsBinp ?delta binp"
unfolding wlsBinp_iff sameDom_def liftAll2_def using delta
by (auto simp: binp_def 1 someI2_ex split: if_splits)
have "wls s (Op ?delta inp binp)"
using inp binp st using Op_preserves_wls[of ?delta inp binp] by simp
thus ?thesis by blast
qed
qed(insert assms, auto)
lemma wf_exists_wlsAbs:
assumes "isInBar (us,s)"
and "wf R" and "⋀s. (∃ xs. s = asSort xs) ∨ witOpS s (f s) R"
shows "∃ A. wlsAbs (us,s) A"
using assms by (auto intro: exists_wls_imp_exists_wlsAbs wf_exists_wls)
subsubsection ‹Well-sorted implies Good›
lemma wlsInp_empAr_empInp[simp]:
assumes "wlsOpS delta" and "arOf delta = empAr"
shows "wlsInp delta empInp"
using assms
unfolding wlsInp_iff sameDom_def liftAll2_def by auto
lemma wlsBinp_empBar_empBinp[simp]:
assumes "wlsOpS delta" and "barOf delta = empBar"
shows "wlsBinp delta empBinp"
using assms unfolding wlsBinp_iff sameDom_def liftAll2_def by auto
lemmas empInp_otherSimps =
wlsInp_empAr_empInp wlsBinp_empBar_empBinp
lemma wlsAll_implies_goodAll:
"(wls s X ⟶ good X) ∧
(wlsAbs (xs,s') A ⟶ goodAbs A) ∧
(wlsInp delta inp ⟶ goodInp inp) ∧
(wlsBinp delta binp ⟶ goodBinp binp)"
apply(induct rule: wls_wlsAbs_wlsInp_wlsBinp.induct)
subgoal by auto
subgoal by auto
subgoal unfolding goodInp_def liftAll_def
by simp (smt Collect_cong arityOf_lt_var_INNER option.distinct(1) option.sel)
subgoal unfolding goodBinp_def liftAll_def
by simp (smt Collect_cong barityOf_lt_var_INNER option.distinct(1) option.sel)
subgoal by auto .
corollary wls_imp_good[simp]: "wls s X ⟹ good X"
by(simp add: wlsAll_implies_goodAll)
corollary wlsAbs_imp_goodAbs[simp]: "wlsAbs (xs,s) A ⟹ goodAbs A"
by(simp add: wlsAll_implies_goodAll)
corollary wlsInp_imp_goodInp[simp]: "wlsInp delta inp ⟹ goodInp inp"
by(simp add: wlsAll_implies_goodAll)
corollary wlsBinp_imp_goodBinp[simp]: "wlsBinp delta binp ⟹ goodBinp binp"
by(simp add: wlsAll_implies_goodAll)
lemma wlsEnv_imp_goodEnv[simp]: "wlsEnv rho ⟹ goodEnv rho"
unfolding wlsEnv_def goodEnv_def liftAll_def
by simp (insert wls_imp_good, blast)
lemmas wlsAll_imp_goodAll =
wls_imp_good wlsAbs_imp_goodAbs
wlsInp_imp_goodInp wlsBinp_imp_goodBinp
wlsEnv_imp_goodEnv
subsubsection ‹Swapping preserves well-sortedness›
lemma swapAll_pres_wlsAll:
"(wls s X ⟶ wls s (X #[z1 ∧ z2]_zs)) ∧
(wlsAbs (xs,s') A ⟶ wlsAbs (xs,s') (A $[z1 ∧ z2]_zs)) ∧
(wlsInp delta inp ⟶ wlsInp delta (inp %[z1 ∧ z2]_zs)) ∧
(wlsBinp delta binp ⟶ wlsBinp delta (binp %%[z1 ∧ z2]_zs))"
proof(induct rule: wls_wlsAbs_wlsInp_wlsBinp.induct)
case (Inp delta inp)
then show ?case
unfolding wlsInp_iff sameDom_def liftAll2_def lift_def swapInp_def
using option.sel by (fastforce simp add: split: option.splits)
next
case (Binp delta binp)
then show ?case
unfolding wlsBinp_iff sameDom_def liftAll2_def lift_def swapBinp_def
using option.sel by (fastforce simp add: split: option.splits)
qed(insert Cons_preserve_wls, simp_all)
lemma swap_preserves_wls[simp]:
"wls s X ⟹ wls s (X #[z1 ∧ z2]_zs)"
by(simp add: swapAll_pres_wlsAll)
lemma swap_preserves_wls2[simp]:
assumes "good X"
shows "wls s (X #[z1 ∧ z2]_zs) = wls s X"
using assms swap_preserves_wls[of s "X #[z1 ∧ z2]_zs" zs z1 z2] by auto
lemma swap_preserves_wls3:
assumes "good X" and "good Y"
and "(X #[x1 ∧ x2]_xs) = (Y #[y1 ∧ y2]_ys)"
shows "wls s X = wls s Y"
by (metis assms swap_preserves_wls2)
lemma swapAbs_preserves_wls[simp]:
"wlsAbs (xs,x) A ⟹ wlsAbs (xs,x) (A $[z1 ∧ z2]_zs)"
by(simp add: swapAll_pres_wlsAll)
lemma swapInp_preserves_wls[simp]:
"wlsInp delta inp ⟹ wlsInp delta (inp %[z1 ∧ z2]_zs)"
by(simp add: swapAll_pres_wlsAll)
lemma swapBinp_preserves_wls[simp]:
"wlsBinp delta binp ⟹ wlsBinp delta (binp %%[z1 ∧ z2]_zs)"
by(simp add: swapAll_pres_wlsAll)
lemma swapEnvDom_preserves_wls:
assumes "wlsEnv rho"
shows "wlsEnv (swapEnvDom xs x y rho)"
proof-
{fix xsa ys let ?Left = "{ya. swapEnvDom xs x y rho ys ya ≠ None}"
have "|{y} ∪ {ya. rho ys ya ≠ None}| <o |UNIV :: 'var set|"
using assms var_infinite_INNER card_of_Un_singl_ordLess_infinite
unfolding wlsEnv_def by fastforce
hence "|{x,y} ∪ {ya. rho ys ya ≠ None}| <o |UNIV :: 'var set|"
using var_infinite_INNER card_of_Un_singl_ordLess_infinite by fastforce
moreover
{have "?Left ⊆ {x,y} ∪ {ya. rho ys ya ≠ None}"
unfolding swapEnvDom_def sw_def[abs_def] by auto
hence "|?Left| ≤o |{x,y} ∪ {ya. rho ys ya ≠ None}|"
using card_of_mono1 by auto
}
ultimately have "|?Left| <o |UNIV :: 'var set|"
using ordLeq_ordLess_trans by blast
}
thus ?thesis using assms unfolding wlsEnv_def liftAll_def
by (auto simp add: swapEnvDom_def)
qed
lemma swapEnvIm_preserves_wls:
assumes "wlsEnv rho"
shows "wlsEnv (swapEnvIm xs x y rho)"
using assms unfolding wlsEnv_def swapEnvIm_def liftAll_def lift_def
by (auto split: option.splits)
lemma swapEnv_preserves_wls[simp]:
assumes "wlsEnv rho"
shows "wlsEnv (rho &[z1 ∧ z2]_zs)"
unfolding swapEnv_def comp_def
using assms by(auto simp: swapEnvDom_preserves_wls swapEnvIm_preserves_wls)
lemmas swapAll_preserve_wls =
swap_preserves_wls swapAbs_preserves_wls
swapInp_preserves_wls swapBinp_preserves_wls
swapEnv_preserves_wls
lemma swapped_preserves_wls:
assumes "wls s X" and "(X,Y) ∈ swapped"
shows "wls s Y"
proof-
have "(X,Y) ∈ swapped ⟹ wls s X ⟶ wls s Y"
by (induct rule: swapped.induct) auto
thus ?thesis using assms by simp
qed
subsubsection ‹Inversion rules for well-sortedness›
lemma wlsAll_inversion:
"(wls s X ⟶
(∀ xs x. X = Var xs x ⟶ s = asSort xs) ∧
(∀ delta inp binp. goodInp inp ∧ goodBinp binp ∧ X = Op delta inp binp ⟶
stOf delta = s ∧ wlsInp delta inp ∧ wlsBinp delta binp))
∧
(wlsAbs xs_s A ⟶
isInBar xs_s ∧
(∀ x X. good X ∧ A = Abs (fst xs_s) x X ⟶
wls (snd xs_s) X))
∧
(wlsInp delta inp ⟶ True)
∧
(wlsBinp delta binp ⟶ True)"
proof(induct rule: wls_wlsAbs_wlsInp_wlsBinp.induct)
case (Abs xs s X x)
then show ?case using swap_preserves_wls3 wls_imp_good
by (metis FixVars.Abs_ainj_ex FixVars_axioms snd_conv)
qed (auto simp: Abs_ainj_ex)
lemma conjLeft: "⟦phi1 ∧ phi2; phi1 ⟹ chi⟧ ⟹ chi"
by blast
lemma conjRight: "⟦phi1 ∧ phi2; phi2 ⟹ chi⟧ ⟹ chi"
by blast
lemma wls_inversion[rule_format]:
"wls s X ⟶
(∀ xs x. X = Var xs x ⟶ s = asSort xs) ∧
(∀ delta inp binp. goodInp inp ∧ goodBinp binp ∧ X = Op delta inp binp ⟶
stOf delta = s ∧ wlsInp delta inp ∧ wlsBinp delta binp)"
using wlsAll_inversion
[of s X undefined undefined undefined undefined undefined]
by (rule conjLeft)
lemma wlsAbs_inversion[rule_format]:
"wlsAbs (xs,s) A ⟶
isInBar (xs,s) ∧
(∀ x X. good X ∧ A = Abs xs x X ⟶ wls s X)"
using wlsAll_inversion
[of undefined undefined "(xs,s)" A undefined undefined undefined]
by auto
lemma wls_Var_simp[simp]:
"wls s (Var xs x) = (s = asSort xs)"
using wls_inversion by auto
lemma wls_Op_simp[simp]:
assumes "goodInp inp" and "goodBinp binp"
shows
"wls s (Op delta inp binp) =
(stOf delta = s ∧ wlsInp delta inp ∧ wlsBinp delta binp)"
using Op assms wls_inversion by blast
lemma wls_Abs_simp[simp]:
assumes "good X"
shows "wlsAbs (xs,s) (Abs xs x X) = (isInBar (xs,s) ∧ wls s X)"
using Abs assms wlsAbs_inversion by blast
lemma wlsAll_inversion2:
"(wls s X ⟶ True)
∧
(wlsAbs xs_s A ⟶
isInBar xs_s ∧
(∃ x X. wls (snd xs_s) X ∧ A = Abs (fst xs_s) x X))
∧
(wlsInp delta inp ⟶ True)
∧
(wlsBinp delta binp ⟶ True)"
by (induct rule: wls_wlsAbs_wlsInp_wlsBinp.induct)
(auto simp add: Abs_ainj_ex simp del: not_None_eq)
lemma wlsAbs_inversion2[rule_format]:
"wlsAbs (xs,s) A ⟶
isInBar (xs,s) ∧ (∃ x X. wls s X ∧ A = Abs xs x X)"
using wlsAll_inversion2 by auto
corollary wlsAbs_Abs_varSort:
assumes X: "good X" and wlsAbs: "wlsAbs (xs,s) (Abs xs' x X)"
shows "xs = xs'"
by (metis Abs_ainj_all X wlsAbs wlsAbs_inversion2 wls_imp_good)
lemma wlsAbs:
"wlsAbs (xs,s) A ⟷
isInBar (xs,s) ∧ (∃ x X. wls s X ∧ A = Abs xs x X)"
using Abs wlsAbs_inversion2 by blast
lemma wlsAbs_Abs[simp]:
assumes X: "good X"
shows "wlsAbs (xs',s) (Abs xs x X) = (isInBar (xs',s) ∧ xs = xs' ∧ wls s X)"
using assms wlsAbs_Abs_varSort by fastforce
lemmas Cons_wls_simps =
wls_Var_simp wls_Op_simp wls_Abs_simp wlsAbs_Abs
subsection ‹Induction principles for well-sorted terms›
subsubsection ‹Regular induction›
theorem wls_templateInduct[case_names rel Var Op Abs]:
assumes
rel: "⋀ s X Y. ⟦wls s X; (X,Y) ∈ rel s⟧ ⟹ wls s Y ∧ skel Y = skel X" and
Var: "⋀ xs x. phi (asSort xs) (Var xs x)" and
Op:
"⋀ delta inp binp.
⟦wlsInp delta inp; wlsBinp delta binp;
liftAll2 phi (arOf delta) inp; liftAll2 phiAbs (barOf delta) binp⟧
⟹ phi (stOf delta) (Op delta inp binp)" and
Abs:
"⋀ s xs x X.
⟦isInBar (xs,s); wls s X; ⋀ Y. (X,Y) ∈ rel s ⟹ phi s Y⟧
⟹ phiAbs (xs,s) (Abs xs x X)"
shows
"(wls s X ⟶ phi s X) ∧
(wlsAbs (xs,s') A ⟶ phiAbs (xs,s') A)"
proof-
have "(good X ⟶ (∀ s. wls s X ⟶ phi s X)) ∧
(goodAbs A ⟶ (∀ xs s. wlsAbs (xs,s) A ⟶ phiAbs (xs,s) A))"
apply(induct rule: term_templateInduct[of "{(X,Y). ∃ s. wls s X ∧ (X,Y) ∈ rel s}"])
subgoal using rel wls_imp_good by blast
subgoal using Var by auto
subgoal by (auto intro!: Op simp: wlsInp_iff wlsBinp_iff liftAll_def liftAll2_def)
subgoal using Abs rel by simp blast .
thus ?thesis by auto
qed
theorem wls_rawInduct[case_names Var Op Abs]:
assumes
Var: "⋀ xs x. phi (asSort xs) (Var xs x)" and
Op:
"⋀ delta inp binp.
⟦wlsInp delta inp; wlsBinp delta binp;
liftAll2 phi (arOf delta) inp; liftAll2 phiAbs (barOf delta) binp⟧
⟹ phi (stOf delta) (Op delta inp binp)" and
Abs: "⋀ s xs x X. ⟦isInBar (xs,s); wls s X; phi s X⟧ ⟹ phiAbs (xs,s) (Abs xs x X)"
shows
"(wls s X ⟶ phi s X) ∧
(wlsAbs (xs,s') A ⟶ phiAbs (xs,s') A)"
by (induct rule: wls_templateInduct[of "λs. Id"]) (simp_all add: assms)
subsubsection ‹Fresh induction›
text ‹First for an unspecified notion of parameter:›
theorem wls_templateInduct_fresh[case_names Par Rel Var Op Abs]:
fixes s X xs s' A phi phiAbs rel
and vars :: "'varSort ⇒ 'var set"
and terms :: "'sort ⇒ ('index,'bindex,'varSort,'var,'opSym)term set"
and abs :: "('varSort * 'sort) ⇒ ('index,'bindex,'varSort,'var,'opSym)abs set"
and envs :: "('index,'bindex,'varSort,'var,'opSym)env set"
assumes
PAR:
"⋀ xs us s.
( |vars xs| <o |UNIV :: 'var set| ∨ finite (vars xs)) ∧
( |terms s| <o |UNIV :: 'var set| ∨ finite (terms s)) ∧
( |abs (us,s)| <o |UNIV :: 'var set| ∨ finite (abs (us,s))) ∧
(∀ X ∈ terms s. wls s X) ∧
(∀ A ∈ abs (us,s). wlsAbs (us,s) A) ∧
( |envs| <o |UNIV :: 'var set| ∨ finite (envs)) ∧
(∀ rho ∈ envs. wlsEnv rho)" and
rel: "⋀ s X Y. ⟦wls s X; (X,Y) ∈ rel s⟧ ⟹ wls s Y ∧ skel Y = skel X" and
Var: "⋀ xs x. phi (asSort xs) (Var xs x)" and
Op:
"⋀ delta inp binp.
⟦wlsInp delta inp; wlsBinp delta binp;
liftAll2 (λs X. phi s X) (arOf delta) inp;
liftAll2 (λ(us,s) A. phiAbs (us,s) A) (barOf delta) binp⟧
⟹ phi (stOf delta) (Op delta inp binp)" and
Abs:
"⋀ s xs x X.
⟦isInBar (xs,s); wls s X;
x ∉ vars xs;
⋀ s' Y. Y ∈ terms s' ⟹ fresh xs x Y;
⋀ xs' s' A. A ∈ abs (xs',s') ⟹ freshAbs xs x A;
⋀ rho. rho ∈ envs ⟹ freshEnv xs x rho;
⋀ Y. (X,Y) ∈ rel s ⟹ phi s Y⟧
⟹ phiAbs (xs,s) (Abs xs x X)"
shows
"(wls s X ⟶ phi s X) ∧
(wlsAbs (xs,s') A ⟶ phiAbs (xs,s') A)"
proof-
let ?terms = "⋃ s. terms s"
let ?abs = "⋃ xs s. abs (xs,s)"
have "∀ s. |terms s| <o |UNIV :: 'var set|"
using PAR var_infinite_INNER finite_ordLess_infinite2 by blast
hence 1:"|⋃s. terms s| <o |UNIV :: 'var set|"
using sort_lt_var_INNER var_regular_INNER regular_UNION by blast
have "∀ us s. |abs (us,s)| <o |UNIV :: 'var set|"
using PAR var_infinite_INNER finite_ordLess_infinite2 by blast
hence "∀ us. |⋃s. abs (us,s)| <o |UNIV :: 'var set|"
by(auto simp add: sort_lt_var_INNER var_regular_INNER regular_UNION)
hence 2: "|⋃ us s. abs (us,s)| <o |UNIV :: 'var set|"
using varSort_lt_var_INNER var_regular_INNER by(auto simp add: regular_UNION)
have "(good X ⟶ (∀ s. wls s X ⟶ phi s X)) ∧
(goodAbs A ⟶ (∀ xs s. wlsAbs (xs,s) A ⟶ phiAbs (xs,s) A))"
apply(induct rule: term_templateInduct_fresh
[of vars ?terms ?abs envs
"{(X,Y). ∃ s. wls s X ∧ (X,Y) ∈ rel s}"])
subgoal for xs
using PAR 1 2 apply simp_all using wls_imp_good wlsAbs_imp_goodAbs by blast+
subgoal using assms by simp (meson wls_imp_good)
subgoal using assms by simp
subgoal using assms by simp
(smt liftAll2_def liftAll_def option.distinct(1)
option.sel wlsBinp.cases wlsInp_iff)
subgoal using assms by simp metis .
thus ?thesis by auto
qed
text‹A version of the above not employing any relation for
the abstraction case:›
theorem wls_rawInduct_fresh[case_names Par Var Op Abs]:
fixes s X xs s' A phi phiAbs
and vars :: "'varSort ⇒ 'var set"
and terms :: "'sort ⇒ ('index,'bindex,'varSort,'var,'opSym)term set"
and abs :: "('varSort * 'sort) ⇒ ('index,'bindex,'varSort,'var,'opSym)abs set"
and envs :: "('index,'bindex,'varSort,'var,'opSym)env set"
assumes
PAR:
"⋀ xs us s.
( |vars xs| <o |UNIV :: 'var set| ∨ finite (vars xs)) ∧
( |terms s| <o |UNIV :: 'var set| ∨ finite (terms s)) ∧
(∀ X ∈ terms s. wls s X) ∧
( |abs (us,s)| <o |UNIV :: 'var set| ∨ finite (abs (us,s))) ∧
(∀ A ∈ abs (us,s). wlsAbs (us,s) A) ∧
( |envs| <o |UNIV :: 'var set| ∨ finite (envs)) ∧
(∀ rho ∈ envs. wlsEnv rho)" and
Var: "⋀ xs x. phi (asSort xs) (Var xs x)" and
Op:
"⋀ delta inp binp.
⟦wlsInp delta inp; wlsBinp delta binp;
liftAll2 (λs X. phi s X) (arOf delta) inp;
liftAll2 (λ(us,s) A. phiAbs (us,s) A) (barOf delta) binp⟧
⟹ phi (stOf delta) (Op delta inp binp)" and
Abs:
"⋀ s xs x X.
⟦isInBar (xs,s); wls s X;
x ∉ vars xs;
⋀ s' Y. Y ∈ terms s' ⟹ fresh xs x Y;
⋀ us s' A. A ∈ abs (us,s') ⟹ freshAbs xs x A;
⋀ rho. rho ∈ envs ⟹ freshEnv xs x rho;
phi s X⟧
⟹ phiAbs (xs,s) (Abs xs x X)"
shows
"(wls s X ⟶ phi s X) ∧
(wlsAbs (xs,s') A ⟶ phiAbs (xs,s') A)"
apply(induct rule: wls_templateInduct_fresh[of vars terms abs envs "λs. Id"])
using assms by auto
text‹Then for our notion of sorted parameter:›
theorem wls_induct_fresh[case_names Par Var Op Abs]:
fixes X :: "('index,'bindex,'varSort,'var,'opSym)term" and s and
A :: "('index,'bindex,'varSort,'var,'opSym)abs" and xs s' and
P :: "('index,'bindex,'varSort,'var,'opSym,'sort)paramS" and phi phiAbs
assumes
P: "wlsPar P" and
Var: "⋀ xs x. phi (asSort xs) (Var xs x)" and
Op:
"⋀ delta inp binp.
⟦wlsInp delta inp; wlsBinp delta binp;
liftAll2 (λs X. phi s X) (arOf delta) inp;
liftAll2 (λ(us,s) A. phiAbs (us,s) A) (barOf delta) binp⟧
⟹ phi (stOf delta) (Op delta inp binp)" and
Abs:
"⋀ s xs x X.
⟦isInBar (xs,s); wls s X;
x ∉ varsOfS P xs;
⋀ s' Y. Y ∈ termsOfS P s' ⟹ fresh xs x Y;
⋀ us s' A. A ∈ absOfS P (us,s') ⟹ freshAbs xs x A;
⋀ rho. rho ∈ envsOfS P ⟹ freshEnv xs x rho;
phi s X⟧
⟹ phiAbs (xs,s) (Abs xs x X)"
shows
"(wls s X ⟶ phi s X) ∧
(wlsAbs (xs,s') A ⟶ phiAbs (xs,s') A)"
proof(induct rule: wls_rawInduct_fresh
[of "varsOfS P" "termsOfS P" "absOfS P" "envsOfS P" _ _ s X xs s' A])
case (Par xs us s)
then show ?case using assms by(cases P) simp
qed(insert assms, simp_all)
subsubsection ‹The syntactic constructs are almost free (on well-sorted terms)›
theorem wls_Op_inj[simp]:
assumes "wlsInp delta inp" and "wlsBinp delta binp"
and "wlsInp delta' inp'" and "wlsBinp delta' binp'"
shows
"(Op delta inp binp = Op delta' inp' binp') =
(delta = delta' ∧ inp = inp' ∧ binp = binp')"
using assms by simp
lemma wls_Abs_ainj_all:
assumes "wls s X" and "wls s' X'"
shows
"(Abs xs x X = Abs xs' x' X') =
(xs = xs' ∧
(∀ y. (y = x ∨ fresh xs y X) ∧ (y = x' ∨ fresh xs y X') ⟶
(X #[y ∧ x]_xs) = (X' #[y ∧ x']_xs)))"
using assms by(simp add: Abs_ainj_all)
theorem wls_Abs_swap_all:
assumes "wls s X" and "wls s X'"
shows
"(Abs xs x X = Abs xs x' X') =
(∀ y. (y = x ∨ fresh xs y X) ∧ (y = x' ∨ fresh xs y X') ⟶
(X #[y ∧ x]_xs) = (X' #[y ∧ x']_xs))"
using assms by(simp add: wls_Abs_ainj_all)
lemma wls_Abs_ainj_ex:
assumes "wls s X" and "wls s X'"
shows
"(Abs xs x X = Abs xs' x' X') =
(xs = xs' ∧
(∃ y. y ∉ {x,x'} ∧ fresh xs y X ∧ fresh xs y X' ∧
(X #[y ∧ x]_xs) = (X' #[y ∧ x']_xs)))"
using assms by(simp add: Abs_ainj_ex)
theorem wls_Abs_swap_ex:
assumes "wls s X" and "wls s X'"
shows
"(Abs xs x X = Abs xs x' X') =
(∃ y. y ∉ {x,x'} ∧ fresh xs y X ∧ fresh xs y X' ∧
(X #[y ∧ x]_xs) = (X' #[y ∧ x']_xs))"
using assms by(simp add: wls_Abs_ainj_ex)
theorem wls_Abs_inj[simp]:
assumes "wls s X" and "wls s X'"
shows
"(Abs xs x X = Abs xs x X') =
(X = X')"
using assms by (auto simp: wls_Abs_swap_all)
theorem wls_Abs_swap_cong[fundef_cong]:
assumes "wls s X" and "wls s X'"
and "fresh xs y X" and "fresh xs y X'" and "(X #[y ∧ x]_xs) = (X' #[y ∧ x']_xs)"
shows "Abs xs x X = Abs xs x' X'"
using assms by (intro Abs_cong) auto
theorem wls_Abs_swap_fresh[simp]:
assumes "wls s X" and "fresh xs x' X"
shows "Abs xs x' (X #[x' ∧ x]_xs) = Abs xs x X"
using assms by(simp add: Abs_swap_fresh)
theorem wls_Var_diff_Op[simp]:
assumes "wlsInp delta inp" and "wlsBinp delta binp"
shows "Var xs x ≠ Op delta inp binp"
using assms by auto
theorem wls_Op_diff_Var[simp]:
assumes "wlsInp delta inp" and "wlsBinp delta binp"
shows "Op delta inp binp ≠ Var xs x"
using assms by auto
theorem wls_nchotomy:
assumes "wls s X"
shows
"(∃ xs x. asSort xs = s ∧ X = Var xs x) ∨
(∃ delta inp binp. stOf delta = s ∧ wlsInp delta inp ∧ wlsBinp delta binp
∧ X = Op delta inp binp)"
using assms wls.simps by force
lemmas wls_cases = wls_wlsAbs_wlsInp_wlsBinp.inducts(1)
lemmas wlsAbs_nchotomy = wlsAbs_inversion2
theorem wlsAbs_cases:
assumes "wlsAbs (xs,s) A"
and "⋀ x X. ⟦isInBar (xs,s); wls s X⟧ ⟹ phiAbs (xs,s) (Abs xs x X)"
shows "phiAbs (xs,s) A"
using assms wlsAbs_nchotomy by blast
lemma wls_disjoint:
assumes "wls s X" and "wls s' X"
shows "s = s'"
using assms term_nchotomy wls_imp_good by fastforce
lemma wlsAbs_disjoint:
assumes "wlsAbs (xs,s) A" and "wlsAbs (xs',s') A"
shows "xs = xs' ∧ s = s'"
using assms abs_nchotomy wlsAbs_imp_goodAbs wls_disjoint by fastforce
lemmas wls_freeCons =
Var_inj wls_Op_inj wls_Var_diff_Op wls_Op_diff_Var wls_Abs_swap_fresh
subsection ‹The non-construct operators preserve well-sortedness›
lemma idEnv_preserves_wls[simp]:
"wlsEnv idEnv"
proof-
have "goodEnv idEnv" by simp
thus ?thesis unfolding wlsEnv_def goodEnv_def liftAll_def idEnv_def by auto
qed
lemma updEnv_preserves_wls[simp]:
assumes "wlsEnv rho" and "wls (asSort xs) X"
shows "wlsEnv (rho [x ← X]_xs)"
proof-
{fix ys
let ?L = "{y. rho ys y ≠ None}"
let ?R = "{y. (rho [x ← X]_xs) ys y ≠ None}"
have "?R ≤ ?L Un {x}" by auto
hence "|?R| ≤o |?L Un {x}|" by simp
moreover
{have "|?L| <o |UNIV :: 'var set|"
using assms unfolding wlsEnv_def by simp
moreover have "|{x}| <o |UNIV :: 'var set|"
using var_infinite_INNER finite_ordLess_infinite by auto
ultimately have "|?L Un {x}| <o |UNIV :: 'var set|"
using var_infinite_INNER card_of_Un_ordLess_infinite by blast
}
ultimately have "|?R| <o |UNIV :: 'var set|"
using ordLeq_ordLess_trans by blast
} note 0 = this
have 1: "goodEnv (rho [x ← X]_xs)" using assms by simp
show ?thesis unfolding wlsEnv_def goodEnv_def
using 0 1 assms unfolding wlsEnv_def liftAll_def by auto
qed
lemma getEnv_preserves_wls[simp]:
assumes "wlsEnv rho" and "rho xs x = Some X"
shows "wls (asSort xs) X"
using assms unfolding wlsEnv_def liftAll_def by simp
lemmas envOps_preserve_wls =
idEnv_preserves_wls updEnv_preserves_wls
getEnv_preserves_wls
lemma psubstAll_preserves_wlsAll:
assumes P: "wlsPar P"
shows
"(wls s X ⟶ (∀ rho ∈ envsOfS P. wls s (X #[rho]))) ∧
(wlsAbs (xs,s') A ⟶ (∀ rho ∈ envsOfS P. wlsAbs (xs,s') (A $[rho])))"
proof(induct rule: wls_induct_fresh[of P])
case (Var xs x)
show ?case
using assms apply safe subgoal for rho
apply(cases "rho xs x") apply simp_all
using getEnv_preserves_wls wlsPar_def by blast+ .
next
case (Op delta inp binp)
then show ?case using assms
by (auto simp:
wlsInp_iff psubstInp_def wlsBinp_iff psubstBinp_def liftAll2_def lift_def
sameDom_def intro!: Op_preserves_wls split: option.splits)
qed(insert assms, auto)
lemma psubst_preserves_wls[simp]:
"⟦wls s X; wlsEnv rho⟧ ⟹ wls s (X #[rho])"
using psubstAll_preserves_wlsAll[of "ParS (λ_. []) (λ_. []) (λ_. []) [rho]"]
unfolding wlsPar_def by auto
lemma psubstAbs_preserves_wls[simp]:
"⟦wlsAbs (xs,s) A; wlsEnv rho⟧ ⟹ wlsAbs (xs,s) (A $[rho])"
using psubstAll_preserves_wlsAll[of "ParS (λ_. []) (λ_. []) (λ_. []) [rho]"]
unfolding wlsPar_def by auto
lemma psubstInp_preserves_wls[simp]:
assumes "wlsInp delta inp" and "wlsEnv rho"
shows "wlsInp delta (inp %[rho])"
using assms by (auto simp: wlsInp_iff psubstInp_def liftAll2_def lift_def
sameDom_def intro!: Op_preserves_wls split: option.splits)
lemma psubstBinp_preserves_wls[simp]:
assumes "wlsBinp delta binp" and "wlsEnv rho"
shows "wlsBinp delta (binp %%[rho])"
using assms by (auto simp: wlsBinp_iff psubstBinp_def liftAll2_def lift_def
sameDom_def intro!: Op_preserves_wls split: option.splits)
lemma psubstEnv_preserves_wls[simp]:
assumes "wlsEnv rho" and "wlsEnv rho'"
shows "wlsEnv (rho &[rho'])"
proof-
{fix ys y Y
assume "(rho &[rho']) ys y = Some Y"
hence "wls (asSort ys) Y"
using assms unfolding psubstEnv_def wlsEnv_def liftAll_def
by (cases "rho ys y") (auto simp add: assms)
}
moreover have "goodEnv (rho &[rho'])" using assms by simp
ultimately show ?thesis
unfolding goodEnv_def wlsEnv_def psubstEnv_def wlsEnv_def liftAll_def
by (auto simp add: assms)
qed
lemmas psubstAll_preserve_wls =
psubst_preserves_wls psubstAbs_preserves_wls
psubstInp_preserves_wls psubstBinp_preserves_wls
psubstEnv_preserves_wls
lemma subst_preserves_wls[simp]:
assumes "wls s X" and "wls (asSort ys) Y"
shows "wls s (X #[Y / y]_ys)"
using assms unfolding subst_def by simp
lemma substAbs_preserves_wls[simp]:
assumes "wlsAbs (xs,s) A" and "wls (asSort ys) Y"
shows "wlsAbs (xs,s) (A $[Y / y]_ys)"
using assms unfolding substAbs_def by simp
lemma substInp_preserves_wls[simp]:
assumes "wlsInp delta inp" and "wls (asSort ys) Y"
shows "wlsInp delta (inp %[Y / y]_ys)"
using assms unfolding substInp_def by simp
lemma substBinp_preserves_wls[simp]:
assumes "wlsBinp delta binp" and "wls (asSort ys) Y"
shows "wlsBinp delta (binp %%[Y / y]_ys)"
using assms unfolding substBinp_def by simp
lemma substEnv_preserves_wls[simp]:
assumes "wlsEnv rho" and "wls (asSort ys) Y"
shows "wlsEnv (rho &[Y / y]_ys)"
using assms unfolding substEnv_def by simp
lemmas substAll_preserve_wls =
subst_preserves_wls substAbs_preserves_wls
substInp_preserves_wls substBinp_preserves_wls
substEnv_preserves_wls
lemma vsubst_preserves_wls[simp]:
assumes "wls s Y"
shows "wls s (Y #[x1 // x]_xs)"
using assms unfolding vsubst_def by simp
lemma vsubstAbs_preserves_wls[simp]:
assumes "wlsAbs (us,s) A"
shows "wlsAbs (us,s) (A $[x1 // x]_xs)"
using assms unfolding vsubstAbs_def by simp
lemma vsubstInp_preserves_wls[simp]:
assumes "wlsInp delta inp"
shows "wlsInp delta (inp %[x1 // x]_xs)"
using assms unfolding vsubstInp_def by simp
lemma vsubstBinp_preserves_wls[simp]:
assumes "wlsBinp delta binp"
shows "wlsBinp delta (binp %%[x1 // x]_xs)"
using assms unfolding vsubstBinp_def by simp
lemma vsubstEnv_preserves_wls[simp]:
assumes "wlsEnv rho"
shows "wlsEnv (rho &[x1 // x]_xs)"
using assms unfolding vsubstEnv_def by simp
lemmas vsubstAll_preserve_wls = vsubst_preserves_wls vsubstAbs_preserves_wls
vsubstInp_preserves_wls vsubstBinp_preserves_wls vsubstEnv_preserves_wls
lemmas all_preserve_wls = Cons_preserve_wls swapAll_preserve_wls psubstAll_preserve_wls envOps_preserve_wls
substAll_preserve_wls vsubstAll_preserve_wls
subsection ‹Simplification rules for swapping, substitution, freshness and skeleton›
theorem wls_swap_Op_simp[simp]:
assumes "wlsInp delta inp" and "wlsBinp delta binp"
shows
"((Op delta inp binp) #[x1 ∧ x2]_xs) =
Op delta (inp %[x1 ∧ x2]_xs) (binp %%[x1 ∧ x2]_xs)"
using assms by simp
theorem wls_swapAbs_simp[simp]:
assumes "wls s X"
shows "((Abs xs x X) $[y1 ∧ y2]_ys) = Abs xs (x @xs[y1 ∧ y2]_ys) (X #[y1 ∧ y2]_ys)"
using assms by simp
lemmas wls_swapAll_simps =
swap_Var_simp wls_swap_Op_simp wls_swapAbs_simp
theorem wls_fresh_Op_simp[simp]:
assumes "wlsInp delta inp" and "wlsBinp delta binp"
shows
"fresh xs x (Op delta inp binp) =
(freshInp xs x inp ∧ freshBinp xs x binp)"
using assms by simp
theorem wls_freshAbs_simp[simp]:
assumes "wls s X"
shows "freshAbs ys y (Abs xs x X) = (ys = xs ∧ y = x ∨ fresh ys y X)"
using assms by simp
lemmas wls_freshAll_simps =
fresh_Var_simp wls_fresh_Op_simp wls_freshAbs_simp
theorem wls_skel_Op_simp[simp]:
assumes "wlsInp delta inp" and "wlsBinp delta binp"
shows
"skel (Op delta inp binp) = Branch (skelInp inp) (skelBinp binp)"
using assms by simp
lemma wls_skelInp_def2:
assumes "wlsInp delta inp"
shows "skelInp inp = lift skel inp"
using assms by(simp add: skelInp_def2)
lemma wls_skelBinp_def2:
assumes "wlsBinp delta binp"
shows "skelBinp binp = lift skelAbs binp"
using assms by(simp add: skelBinp_def2)
theorem wls_skelAbs_simp[simp]:
assumes "wls s X"
shows "skelAbs (Abs xs x X) = Branch (λi. Some (skel X)) Map.empty"
using assms by simp
lemmas wls_skelAll_simps =
skel_Var_simp wls_skel_Op_simp wls_skelAbs_simp
theorem wls_psubst_Var_simp1[simp]:
assumes "wlsEnv rho" and "rho xs x = None"
shows "((Var xs x) #[rho]) = Var xs x"
using assms by simp
theorem wls_psubst_Var_simp2[simp]:
assumes "wlsEnv rho" and "rho xs x = Some X"
shows "((Var xs x) #[rho]) = X"
using assms by simp
theorem wls_psubst_Op_simp[simp]:
assumes "wlsInp delta inp" and "wlsBinp delta binp" and "wlsEnv rho"
shows
"((Op delta inp binp) #[rho]) = Op delta (inp %[rho]) (binp %%[rho])"
using assms by simp
theorem wls_psubstAbs_simp[simp]:
assumes "wls s X" and "wlsEnv rho" and "freshEnv xs x rho"
shows "((Abs xs x X) $[rho]) = Abs xs x (X #[rho])"
using assms by simp
lemmas wls_psubstAll_simps =
wls_psubst_Var_simp1 wls_psubst_Var_simp2 wls_psubst_Op_simp wls_psubstAbs_simp
lemmas wls_envOps_simps =
getEnv_idEnv getEnv_updEnv1 getEnv_updEnv2
theorem wls_subst_Var_simp1[simp]:
assumes "wls (asSort ys) Y"
and "ys ≠ xs ∨ y ≠ x "
shows "((Var xs x) #[Y / y]_ys) = Var xs x"
using assms unfolding subst_def by auto
theorem wls_subst_Var_simp2[simp]:
assumes "wls (asSort xs) Y"
shows "((Var xs x) #[Y / x]_xs) = Y"
using assms unfolding subst_def by auto
theorem wls_subst_Op_simp[simp]:
assumes "wls (asSort ys) Y"
and "wlsInp delta inp" and "wlsBinp delta binp"
shows
"((Op delta inp binp) #[Y / y]_ys) =
Op delta (inp %[Y / y]_ys) (binp %%[Y / y]_ys)"
using assms unfolding subst_def substInp_def
substAbs_def substBinp_def by auto
theorem wls_substAbs_simp[simp]:
assumes "wls (asSort ys) Y"
and "wls s X" and "xs ≠ ys ∨ x ≠ y" and "fresh xs x Y"
shows "((Abs xs x X) $[Y / y]_ys) = Abs xs x (X #[Y / y]_ys)"
proof-
have "freshEnv xs x (idEnv [y ← Y]_ys)" unfolding freshEnv_def liftAll_def
using assms by simp
thus ?thesis using assms unfolding subst_def substAbs_def by auto
qed
lemmas wls_substAll_simps =
wls_subst_Var_simp1 wls_subst_Var_simp2 wls_subst_Op_simp wls_substAbs_simp
theorem wls_vsubst_Op_simp[simp]:
assumes "wlsInp delta inp" and "wlsBinp delta binp"
shows
"((Op delta inp binp) #[y1 // y]_ys) =
Op delta (inp %[y1 // y]_ys) (binp %%[y1 // y]_ys)"
using assms unfolding vsubst_def vsubstInp_def
vsubstAbs_def vsubstBinp_def by simp
theorem wls_vsubstAbs_simp[simp]:
assumes "wls s X" and
"xs ≠ ys ∨ x ∉ {y,y1}"
shows "((Abs xs x X) $[y1 // y]_ys) = Abs xs x (X #[y1 // y]_ys)"
using assms unfolding vsubst_def vsubstAbs_def by simp
lemmas wls_vsubstAll_simps =
vsubst_Var_simp wls_vsubst_Op_simp wls_vsubstAbs_simp
theorem wls_swapped_skel:
assumes "wls s X" and "(X,Y) ∈ swapped"
shows "skel Y = skel X"
apply(rule swapped_skel) using assms by auto
theorem wls_obtain_rep:
assumes "wls s X" and FRESH: "fresh xs x' X"
shows "∃ X'. skel X' = skel X ∧ (X,X') ∈ swapped ∧ wls s X' ∧ Abs xs x X = Abs xs x' X'"
proof-
have 0: "skel (X #[x' ∧ x]_xs) = skel X" using assms by(simp add: skel_swap)
have 1: "wls s (X #[x' ∧ x]_xs)" using assms swap_preserves_wls by auto
have 2: "(X, X #[x' ∧ x]_xs) ∈ swapped" using Var swap_swapped by auto
show ?thesis using assms 0 1 2 by fastforce
qed
lemmas wls_allOpers_simps =
wls_swapAll_simps
wls_freshAll_simps
wls_skelAll_simps
wls_envOps_simps
wls_psubstAll_simps
wls_substAll_simps
wls_vsubstAll_simps
subsection ‹The ability to pick fresh variables›
theorem wls_single_non_fresh_ordLess_var:
"wls s X ⟹ |{x. ¬ fresh xs x X}| <o |UNIV :: 'var set|"
by(simp add: single_non_fresh_ordLess_var)
theorem wls_single_non_freshAbs_ordLess_var:
"wlsAbs (us,s) A ⟹ |{x. ¬ freshAbs xs x A}| <o |UNIV :: 'var set|"
by(simp add: single_non_freshAbs_ordLess_var)
theorem wls_obtain_fresh:
fixes V::"'varSort ⇒ 'var set" and
XS::"'sort ⇒ ('index,'bindex,'varSort,'var,'opSym)term set" and
AS::"'varSort ⇒ 'sort ⇒ ('index,'bindex,'varSort,'var,'opSym)abs set" and
Rho::"('index,'bindex,'varSort,'var,'opSym)env set" and zs
assumes VVar: "∀ xs. |V xs| <o |UNIV :: 'var set| ∨ finite (V xs)"
and XSVar: "∀ s. |XS s| <o |UNIV :: 'var set| ∨ finite (XS s)"
and ASVar: "∀ xs s. |AS xs s| <o |UNIV :: 'var set| ∨ finite (AS xs s)"
and XSwls: "∀ s. ∀ X ∈ XS s. wls s X"
and ASwls: "∀ xs s. ∀ A ∈ AS xs s. wlsAbs (xs,s) A"
and RhoVar: "|Rho| <o |UNIV :: 'var set| ∨ finite Rho"
and Rhowls: "∀ rho ∈ Rho. wlsEnv rho"
shows
"∃ z. (∀ xs. z ∉ V xs) ∧
(∀ s. ∀ X ∈ XS s. fresh zs z X) ∧
(∀ xs s. ∀ A ∈ AS xs s. freshAbs zs z A) ∧
(∀ rho ∈ Rho. freshEnv zs z rho)"
proof-
let ?VG = "⋃ xs. V xs" let ?XSG = "⋃ s. XS s" let ?ASG = "⋃ xs s. AS xs s"
have "∀ xs. |V xs| <o |UNIV :: 'var set|" using VVar finite_ordLess_var by auto
hence 1: "|?VG| <o |UNIV :: 'var set|"
using var_regular_INNER varSort_lt_var_INNER regular_UNION by blast
have "∀ s. |XS s| <o |UNIV :: 'var set|" using XSVar finite_ordLess_var by auto
hence 2: "|?XSG| <o |UNIV :: 'var set|"
using var_regular_INNER sort_lt_var_INNER regular_UNION by blast
have "∀ xs s. |AS xs s| <o |UNIV :: 'var set|" using ASVar finite_ordLess_var by auto
hence "∀ xs. |⋃ s. AS xs s| <o |UNIV :: 'var set|"
using var_regular_INNER sort_lt_var_INNER regular_UNION by blast
hence 3: "|?ASG| <o |UNIV :: 'var set|"
using var_regular_INNER varSort_lt_var_INNER by (auto simp add: regular_UNION)
have "∃ z. z ∉ ?VG ∧
(∀ X ∈ ?XSG. fresh zs z X) ∧
(∀ A ∈ ?ASG. freshAbs zs z A) ∧
(∀ rho ∈ Rho. freshEnv zs z rho)"
using assms 1 2 3 by (intro obtain_fresh) fastforce+
thus ?thesis by auto
qed
theorem wls_obtain_fresh_paramS:
assumes "wlsPar P"
shows
"∃ z.
(∀ xs. z ∉ varsOfS P xs) ∧
(∀ s. ∀ X ∈ termsOfS P s. fresh zs z X) ∧
(∀ us s. ∀ A ∈ absOfS P (us,s). freshAbs zs z A) ∧
(∀ rho ∈ envsOfS P. freshEnv zs z rho)"
using assms by(cases P) (auto intro: wls_obtain_fresh)
lemma wlsAbs_freshAbs_nchotomy:
assumes A: "wlsAbs (xs,s) A" and fresh: "freshAbs xs x A"
shows "∃ X. wls s X ∧ A = Abs xs x X"
proof-
{assume "wlsAbs (xs,s) A"
hence "freshAbs xs x A ⟶ (∃ X. wls s X ∧ A = Abs xs x X)"
using fresh wls_obtain_rep[of s _ xs x] by (fastforce elim!: wlsAbs_cases)
}
thus ?thesis using assms by auto
qed
theorem wlsAbs_fresh_nchotomy:
assumes A: "wlsAbs (xs,s) A" and P: "wlsPar P"
shows "∃ x X. A = Abs xs x X ∧
wls s X ∧
(∀ ys. x ∉ varsOfS P ys) ∧
(∀ s'. ∀ Y ∈ termsOfS P s'. fresh xs x Y) ∧
(∀ us s'. ∀ B ∈ absOfS P (us,s'). freshAbs xs x B) ∧
(∀ rho ∈ envsOfS P. freshEnv xs x rho)"
proof-
let ?chi =
"λ x. (∀ xs. x ∉ varsOfS P xs) ∧
(∀ s'. ∀ Y ∈ termsOfS P s'. fresh xs x Y) ∧
(∀ us s'.∀ B ∈ (if us = xs ∧ s' = s then {A} else {}) ∪ absOfS P (us,s'). freshAbs xs x B) ∧
(∀ rho ∈ envsOfS P. freshEnv xs x rho)"
have "∃ x. ?chi x"
using A P by (intro wls_obtain_fresh) (cases P, auto)+
then obtain x where 1: "?chi x" by blast
hence "freshAbs xs x A" by fastforce
then obtain X where X: "wls s X" and 2: "A = Abs xs x X"
using A 1 wlsAbs_freshAbs_nchotomy[of xs s A x] by auto
thus ?thesis using 1 by blast
qed
theorem wlsAbs_fresh_cases:
assumes "wlsAbs (xs,s) A" and "wlsPar P"
and "⋀ x X.
⟦wls s X;
⋀ ys. x ∉ varsOfS P ys;
⋀ s' Y. Y ∈ termsOfS P s' ⟹ fresh xs x Y;
⋀ us s' B. B ∈ absOfS P (us,s') ⟹ freshAbs xs x B;
⋀ rho. rho ∈ envsOfS P ⟹ freshEnv xs x rho⟧
⟹ phi (xs,s) (Abs xs x X) P"
shows "phi (xs,s) A P"
by (metis assms wlsAbs_fresh_nchotomy)
subsection ‹Compositionality properties of freshness and swapping›
subsubsection ‹W.r.t. terms›
theorem wls_swap_ident[simp]:
assumes "wls s X"
shows "(X #[x ∧ x]_xs) = X"
using assms by simp
theorem wls_swap_compose:
assumes "wls s X"
shows "((X #[x ∧ y]_zs) #[x' ∧ y']_zs') =
((X #[x' ∧ y']_zs') #[(x @zs[x' ∧ y']_zs') ∧ (y @zs[x' ∧ y']_zs')]_zs)"
using assms by (intro swap_compose) auto
theorem wls_swap_commute:
"⟦wls s X; zs ≠ zs' ∨ {x,y} ∩ {x',y'} = {}⟧ ⟹
((X #[x ∧ y]_zs) #[x' ∧ y']_zs') = ((X #[x' ∧ y']_zs') #[x ∧ y]_zs)"
by (intro swap_commute) auto
theorem wls_swap_involutive[simp]:
assumes "wls s X"
shows "((X #[x ∧ y]_zs) #[x ∧ y]_zs) = X"
using assms by simp
theorem wls_swap_inj[simp]:
assumes "wls s X" and "wls s X'"
shows
"((X #[x ∧ y]_zs) = (X' #[x ∧ y]_zs)) =
(X = X')"
using assms by (metis wls_swap_involutive)
theorem wls_swap_involutive2[simp]:
assumes "wls s X"
shows "((X #[x ∧ y]_zs) #[y ∧ x]_zs) = X"
using assms by (simp add: swap_sym)
theorem wls_swap_preserves_fresh[simp]:
assumes "wls s X"
shows "fresh xs (x @xs[y1 ∧ y2]_ys) (X #[y1 ∧ y2]_ys) = fresh xs x X"
using assms by simp
theorem wls_swap_preserves_fresh_distinct:
assumes "wls s X" and
"xs ≠ ys ∨ x ∉ {y1,y2}"
shows "fresh xs x (X #[y1 ∧ y2]_ys) = fresh xs x X"
using assms by(intro swap_preserves_fresh_distinct) auto
theorem wls_fresh_swap_exchange1:
assumes "wls s X"
shows "fresh xs x2 (X #[x1 ∧ x2]_xs) = fresh xs x1 X"
using assms by (intro fresh_swap_exchange1) auto
theorem wls_fresh_swap_exchange2:
assumes "wls s X"
shows "fresh xs x2 (X #[x2 ∧ x1]_xs) = fresh xs x1 X"
using assms by (intro fresh_swap_exchange2) fastforce+
theorem wls_fresh_swap_id[simp]:
assumes "wls s X" and "fresh xs x1 X" and "fresh xs x2 X"
shows "(X #[x1 ∧ x2]_xs) = X"
using assms by simp
theorem wls_fresh_swap_compose:
assumes "wls s X" and "fresh xs y X" and "fresh xs z X"
shows "((X #[y ∧ x]_xs) #[z ∧ y]_xs) = (X #[z ∧ x]_xs)"
using assms by (intro fresh_swap_compose) auto
theorem wls_skel_swap:
assumes "wls s X"
shows "skel (X #[x1 ∧ x2]_xs) = skel X"
using assms by (intro skel_swap) auto
subsubsection ‹W.r.t. environments›
theorem wls_swapEnv_ident[simp]:
assumes "wlsEnv rho"
shows "(rho &[x ∧ x]_xs) = rho"
using assms by simp
theorem wls_swapEnv_compose:
assumes "wlsEnv rho"
shows "((rho &[x ∧ y]_zs) &[x' ∧ y']_zs') =
((rho &[x' ∧ y']_zs') &[(x @zs[x' ∧ y']_zs') ∧ (y @zs[x' ∧ y']_zs')]_zs)"
using assms by (intro swapEnv_compose) auto
theorem wls_swapEnv_commute:
"⟦wlsEnv rho; zs ≠ zs' ∨ {x,y} ∩ {x',y'} = {}⟧ ⟹
((rho &[x ∧ y]_zs) &[x' ∧ y']_zs') = ((rho &[x' ∧ y']_zs') &[x ∧ y]_zs)"
by (intro swapEnv_commute) fastforce+
theorem wls_swapEnv_involutive[simp]:
assumes "wlsEnv rho"
shows "((rho &[x ∧ y]_zs) &[x ∧ y]_zs) = rho"
using assms by simp
theorem wls_swapEnv_inj[simp]:
assumes "wlsEnv rho" and "wlsEnv rho'"
shows
"((rho &[x ∧ y]_zs) = (rho' &[x ∧ y]_zs)) =
(rho = rho')"
by (metis assms wls_swapEnv_involutive)
theorem wls_swapEnv_involutive2[simp]:
assumes "wlsEnv rho"
shows "((rho &[x ∧ y]_zs) &[y ∧ x]_zs) = rho"
using assms by(simp add: swapEnv_sym)
theorem wls_swapEnv_preserves_freshEnv[simp]:
assumes "wlsEnv rho"
shows "freshEnv xs (x @xs[y1 ∧ y2]_ys) (rho &[y1 ∧ y2]_ys) = freshEnv xs x rho"
using assms by simp
theorem wls_swapEnv_preserves_freshEnv_distinct:
assumes "wlsEnv rho"
"xs ≠ ys ∨ x ∉ {y1,y2}"
shows "freshEnv xs x (rho &[y1 ∧ y2]_ys) = freshEnv xs x rho"
using assms by (intro swapEnv_preserves_freshEnv_distinct) auto
theorem wls_freshEnv_swapEnv_exchange1:
assumes "wlsEnv rho"
shows "freshEnv xs x2 (rho &[x1 ∧ x2]_xs) = freshEnv xs x1 rho"
using assms by (intro freshEnv_swapEnv_exchange1) auto
theorem wls_freshEnv_swapEnv_exchange2:
assumes "wlsEnv rho"
shows "freshEnv xs x2 (rho &[x2 ∧ x1]_xs) = freshEnv xs x1 rho"
using assms by (intro freshEnv_swapEnv_exchange2) auto
theorem wls_freshEnv_swapEnv_id[simp]:
assumes "wlsEnv rho" and "freshEnv xs x1 rho" and "freshEnv xs x2 rho"
shows "(rho &[x1 ∧ x2]_xs) = rho"
using assms by simp
theorem wls_freshEnv_swapEnv_compose:
assumes "wlsEnv rho" and "freshEnv xs y rho" and "freshEnv xs z rho"
shows "((rho &[y ∧ x]_xs) &[z ∧ y]_xs) = (rho &[z ∧ x]_xs)"
using assms by (intro freshEnv_swapEnv_compose) auto
subsubsection ‹W.r.t. abstractions›
theorem wls_swapAbs_ident[simp]:
"wlsAbs (us,s) A ⟹ (A $[x ∧ x]_xs) = A"
by (elim wlsAbs_cases) auto
theorem wls_swapAbs_compose:
"wlsAbs (us,s) A ⟹
((A $[x ∧ y]_zs) $[x' ∧ y']_zs') =
((A $[x' ∧ y']_zs') $[(x @zs[x' ∧ y']_zs') ∧ (y @zs[x' ∧ y']_zs')]_zs)"
by (erule wlsAbs_cases) (simp, metis sw_compose wls_swap_compose)
theorem wls_swapAbs_commute:
assumes "zs ≠ zs' ∨ {x,y} ∩ {x',y'} = {}"
shows
"wlsAbs (us,s) A ⟹
((A $[x ∧ y]_zs) $[x' ∧ y']_zs') = ((A $[x' ∧ y']_zs') $[x ∧ y]_zs)"
using assms by (elim wlsAbs_cases) (simp add: sw_commute wls_swap_commute)
theorem wls_swapAbs_involutive[simp]:
"wlsAbs (us,s) A ⟹ ((A $[x ∧ y]_zs) $[x ∧ y]_zs) = A"
by (erule wlsAbs_cases) simp_all
theorem wls_swapAbs_sym:
"wlsAbs (us,s) A ⟹ (A $[x ∧ y]_zs) = (A $[y ∧ x]_zs)"
by (erule wlsAbs_cases) (auto simp add: swap_sym sw_sym)
theorem wls_swapAbs_inj[simp]:
assumes "wlsAbs (us,s) A" and "wlsAbs (us,s) A'"
shows
"((A $[x ∧ y]_zs) = (A' $[x ∧ y]_zs)) =
(A = A')"
by (metis assms wls_swapAbs_involutive)
theorem wls_swapAbs_involutive2[simp]:
"wlsAbs (us,s) A ⟹ ((A $[x ∧ y]_zs) $[y ∧ x]_zs) = A"
using wls_swapAbs_sym[of us s A zs x y] by auto
theorem wls_swapAbs_preserves_freshAbs[simp]:
"wlsAbs (us,s) A
⟹ freshAbs xs (x @xs[y1 ∧ y2]_ys) (A $[y1 ∧ y2]_ys) = freshAbs xs x A"
by (erule wlsAbs_cases)
(simp_all add: sw_def wls_fresh_swap_exchange1 wls_fresh_swap_exchange2
wls_swap_preserves_fresh_distinct)
theorem wls_swapAbs_preserves_freshAbs_distinct:
"⟦wlsAbs (us,s) A; xs ≠ ys ∨ x ∉ {y1,y2}⟧
⟹ freshAbs xs x (A $[y1 ∧ y2]_ys) = freshAbs xs x A"
apply(erule wlsAbs_cases) apply simp_all
unfolding sw_def by (auto simp: wls_swap_preserves_fresh_distinct)
theorem wls_freshAbs_swapAbs_exchange1:
"wlsAbs (us,s) A
⟹ freshAbs xs x2 (A $[x1 ∧ x2]_xs) = freshAbs xs x1 A"
apply(erule wlsAbs_cases) apply simp_all
unfolding sw_def by (auto simp add: wls_fresh_swap_exchange1)
theorem wls_freshAbs_swapAbs_exchange2:
"wlsAbs (us,s) A
⟹ freshAbs xs x2 (A $[x2 ∧ x1]_xs) = freshAbs xs x1 A"
apply(erule wlsAbs_cases) apply simp_all
unfolding sw_def by (auto simp add: wls_fresh_swap_exchange2)
theorem wls_freshAbs_swapAbs_id[simp]:
assumes "wlsAbs (us,s) A"
and "freshAbs xs x1 A" and "freshAbs xs x2 A"
shows "(A $[x1 ∧ x2]_xs) = A"
using assms by simp
lemma wls_freshAbs_swapAbs_compose_aux:
"⟦wlsAbs (us,s) A; wlsPar P⟧ ⟹
∀ x y z. {x,y,z} ⊆ varsOfS P xs ∧ freshAbs xs y A ∧ freshAbs xs z A ⟶
((A $[y ∧ x]_xs) $[z ∧ y]_xs) = (A $[z ∧ x]_xs)"
apply(erule wlsAbs_fresh_cases)
by simp_all (metis fresh_swap_compose sw_def wls_imp_good)
theorem wls_freshAbs_swapAbs_compose:
assumes "wlsAbs (us,s) A"
and "freshAbs xs y A" and "freshAbs xs z A"
shows "((A $[y ∧ x]_xs) $[z ∧ y]_xs) = (A $[z ∧ x]_xs)"
proof-
let ?P =
"ParS (λxs'. if xs' = xs then [x,y,z] else []) (λs.[]) (λ_. []) [] ::
('index, 'bindex, 'varSort, 'var, 'opSym, 'sort) paramS"
show ?thesis
using assms wls_freshAbs_swapAbs_compose_aux[of us s A ?P xs]
unfolding wlsPar_def by simp
qed
theorem wls_skelAbs_swapAbs:
"wlsAbs (us,s) A
⟹ skelAbs (A $[x1 ∧ x2]_xs) = skelAbs A"
by (erule wlsAbs_cases) (auto simp: wls_skel_swap)
lemmas wls_swapAll_freshAll_otherSimps =
wls_swap_ident wls_swap_involutive wls_swap_inj wls_swap_involutive2 wls_swap_preserves_fresh wls_fresh_swap_id
wls_swapAbs_ident wls_swapAbs_involutive wls_swapAbs_inj wls_swapAbs_involutive2 wls_swapAbs_preserves_freshAbs
wls_freshAbs_swapAbs_id
wls_swapEnv_ident wls_swapEnv_involutive wls_swapEnv_inj wls_swapEnv_involutive2 wls_swapEnv_preserves_freshEnv
wls_freshEnv_swapEnv_id
subsection ‹Compositionality properties for the other operators›
subsubsection ‹Environment identity, update and ``get" versus other operators›
theorem wls_psubst_idEnv[simp]:
"wls s X ⟹ (X #[idEnv]) = X"
by simp
theorem wls_psubstEnv_idEnv_id[simp]:
"wlsEnv rho ⟹ (rho &[idEnv]) = rho"
by simp
theorem wls_swapEnv_updEnv_fresh:
assumes "zs ≠ ys ∨ y ∉ {z1,z2}" and "wls (asSort ys) Y"
and "fresh zs z1 Y" and "fresh zs z2 Y"
shows "((rho [y ← Y]_ys) &[z1 ∧ z2]_zs) = ((rho &[z1 ∧ z2]_zs) [y ← Y]_ys)"
using assms by (simp add: swapEnv_updEnv_fresh)
subsubsection ‹Substitution versus other operators›
theorem wls_fresh_psubst:
assumes "wls s X" and "wlsEnv rho"
shows
"fresh zs z (X #[rho]) =
(∀ ys y. fresh ys y X ∨ freshImEnvAt zs z rho ys y)"
using assms by(simp add: fresh_psubst)
theorem wls_fresh_psubst_E1:
assumes "wls s X" and "wlsEnv rho"
and "rho ys y = None" and "fresh zs z (X #[rho])"
shows "fresh ys y X ∨ (ys ≠ zs ∨ y ≠ z)"
using assms fresh_psubst_E1[of X rho ys y zs z] by simp
theorem wls_fresh_psubst_E2:
assumes "wls s X" and "wlsEnv rho"
and "rho ys y = Some Y" and "fresh zs z (X #[rho])"
shows "fresh ys y X ∨ fresh zs z Y"
using assms fresh_psubst_E2[of X rho ys y Y zs z] by simp
theorem wls_fresh_psubst_I1:
assumes "wls s X" and "wlsEnv rho"
and "fresh zs z X" and "freshEnv zs z rho"
shows "fresh zs z (X #[rho])"
using assms by(simp add: fresh_psubst_I1)
theorem wls_psubstEnv_preserves_freshEnv:
assumes "wlsEnv rho" and "wlsEnv rho'"
and fresh: "freshEnv zs z rho" "freshEnv zs z rho'"
shows "freshEnv zs z (rho &[rho'])"
using assms by(simp add: psubstEnv_preserves_freshEnv)
theorem wls_fresh_psubst_I:
assumes "wls s X" and "wlsEnv rho"
and "rho zs z = None ⟹ fresh zs z X" and
"⋀ ys y Y. rho ys y = Some Y ⟹ fresh ys y X ∨ fresh zs z Y"
shows "fresh zs z (X #[rho])"
using assms by(simp add: fresh_psubst_I)
theorem wls_fresh_subst:
assumes "wls s X" and "wls (asSort ys) Y"
shows "fresh zs z (X #[Y / y]_ys) =
(((zs = ys ∧ z = y) ∨ fresh zs z X) ∧ (fresh ys y X ∨ fresh zs z Y))"
using assms by(simp add: fresh_subst)
theorem wls_fresh_vsubst:
assumes "wls s X"
shows "fresh zs z (X #[y1 // y]_ys) =
(((zs = ys ∧ z = y) ∨ fresh zs z X) ∧ (fresh ys y X ∨ (zs ≠ ys ∨ z ≠ y1)))"
using assms by(simp add: fresh_vsubst)
theorem wls_subst_preserves_fresh:
assumes "wls s X" and "wls (asSort ys) Y"
and "fresh zs z X" and "fresh zs z Y"
shows "fresh zs z (X #[Y / y]_ys)"
using assms by(simp add: subst_preserves_fresh)
theorem wls_substEnv_preserves_freshEnv:
assumes "wlsEnv rho" and "wls (asSort ys) Y"
and "freshEnv zs z rho" and "fresh zs z Y" and "zs ≠ ys ∨ z ≠ y"
shows "freshEnv zs z (rho &[Y / y]_ys)"
using assms by(simp add: substEnv_preserves_freshEnv)
theorem wls_vsubst_preserves_fresh:
assumes "wls s X"
and "fresh zs z X" and "zs ≠ ys ∨ z ≠ y1"
shows "fresh zs z (X #[y1 // y]_ys)"
using assms by(simp add: vsubst_preserves_fresh)
theorem wls_vsubstEnv_preserves_freshEnv:
assumes "wlsEnv rho"
and "freshEnv zs z rho" and "zs ≠ ys ∨ z ∉ {y,y1}"
shows "freshEnv zs z (rho &[y1 // y]_ys)"
using assms by(simp add: vsubstEnv_preserves_freshEnv)
theorem wls_fresh_fresh_subst[simp]:
assumes "wls (asSort ys) Y" and "wls s X"
and "fresh ys y Y"
shows "fresh ys y (X #[Y / y]_ys)"
using assms by(simp add: fresh_fresh_subst)
theorem wls_diff_fresh_vsubst[simp]:
assumes "wls s X"
and "y ≠ y1"
shows "fresh ys y (X #[y1 // y]_ys)"
using assms by(simp add: diff_fresh_vsubst)
theorem wls_fresh_subst_E1:
assumes "wls s X" and "wls (asSort ys) Y"
and "fresh zs z (X #[Y / y]_ys)" and "zs ≠ ys ∨ z ≠ y"
shows "fresh zs z X"
using assms fresh_subst_E1[of X Y zs z ys y] by simp
theorem wls_fresh_vsubst_E1:
assumes "wls s X"
and "fresh zs z (X #[y1 // y]_ys)" and "zs ≠ ys ∨ z ≠ y"
shows "fresh zs z X"
using assms fresh_vsubst_E1[of X zs z ys y1 y] by simp
theorem wls_fresh_subst_E2:
assumes "wls s X" and "wls (asSort ys) Y"
and "fresh zs z (X #[Y / y]_ys)"
shows "fresh ys y X ∨ fresh zs z Y"
using assms fresh_subst_E2[of X Y zs z ys y] by simp
theorem wls_fresh_vsubst_E2:
assumes "wls s X"
and "fresh zs z (X #[y1 // y]_ys)"
shows "fresh ys y X ∨ zs ≠ ys ∨ z ≠ y1"
using assms fresh_vsubst_E2[of X zs z ys y1 y] by simp
theorem wls_psubst_cong[fundef_cong]:
assumes "wls s X" and "wlsEnv rho" and "wlsEnv rho'"
and "⋀ ys y. fresh ys y X ∨ rho ys y = rho' ys y"
shows "(X #[rho]) = (X #[rho'])"
using assms by (simp add: psubst_cong)
theorem wls_fresh_psubst_updEnv:
assumes "wls (asSort ys) Y" and "wls s X" and "wlsEnv rho"
and "fresh ys y X"
shows "(X #[rho [y ← Y]_ys]) = (X #[rho])"
using assms by(simp add: fresh_psubst_updEnv)
theorem wls_freshEnv_psubst_ident[simp]:
assumes "wls s X" and "wlsEnv rho"
and "⋀ zs z. freshEnv zs z rho ∨ fresh zs z X"
shows "(X #[rho]) = X"
using assms by simp
theorem wls_fresh_subst_ident[simp]:
assumes "wls (asSort ys) Y" and "wls s X" and "fresh ys y X"
shows "(X #[Y / y]_ys) = X"
using assms by(simp add: fresh_subst_ident)
theorem wls_substEnv_updEnv_fresh:
assumes "wls (asSort xs) X" and "wls (asSort ys) Y" and "fresh ys y X"
shows "((rho [x ← X]_xs) &[Y / y]_ys) = ((rho &[Y / y]_ys) [x ← X]_xs)"
using assms by(simp add: substEnv_updEnv_fresh)
theorem wls_fresh_substEnv_updEnv[simp]:
assumes "wlsEnv rho" and "wls (asSort ys) Y"
and "freshEnv ys y rho"
shows "(rho &[Y / y]_ys) = (rho [y ← Y]_ys)"
using assms by simp
theorem wls_fresh_vsubst_ident[simp]:
assumes "wls s X" and "fresh ys y X"
shows "(X #[y1 // y]_ys) = X"
using assms by(simp add: fresh_vsubst_ident)
theorem wls_vsubstEnv_updEnv_fresh:
assumes "wls s X" and "fresh ys y X"
shows "((rho [x ← X]_xs) &[y1 // y]_ys) = ((rho &[y1 // y]_ys) [x ← X]_xs)"
using assms by(simp add: vsubstEnv_updEnv_fresh)
theorem wls_fresh_vsubstEnv_updEnv[simp]:
assumes "wlsEnv rho"
and "freshEnv ys y rho"
shows "(rho &[y1 // y]_ys) = (rho [y ← Var ys y1]_ys)"
using assms by simp
theorem wls_swap_psubst:
assumes "wls s X" and "wlsEnv rho"
shows "((X #[rho]) #[z1 ∧ z2]_zs) = ((X #[z1 ∧ z2]_zs) #[rho &[z1 ∧ z2]_zs])"
using assms by(simp add: swap_psubst)
theorem wls_swap_subst:
assumes "wls s X" and "wls (asSort ys) Y"
shows "((X #[Y / y]_ys) #[z1 ∧ z2]_zs) = ((X #[z1 ∧ z2]_zs) #[(Y #[z1 ∧ z2]_zs) / (y @ys[z1 ∧ z2]_zs)]_ys)"
using assms by(simp add: swap_subst)
theorem wls_swap_vsubst:
assumes "wls s X"
shows "((X #[y1 // y]_ys) #[z1 ∧ z2]_zs) = ((X #[z1 ∧ z2]_zs) #[(y1 @ys[z1 ∧ z2]_zs) // (y @ys[z1 ∧ z2]_zs)]_ys)"
using assms by(simp add: swap_vsubst)
theorem wls_swapEnv_psubstEnv:
assumes "wlsEnv rho" and "wlsEnv rho'"
shows "((rho &[rho']) &[z1 ∧ z2]_zs) = ((rho &[z1 ∧ z2]_zs) &[rho' &[z1 ∧ z2]_zs])"
using assms by(simp add: swapEnv_psubstEnv)
theorem wls_swapEnv_substEnv:
assumes "wls (asSort ys) Y" and "wlsEnv rho"
shows "((rho &[Y / y]_ys) &[z1 ∧ z2]_zs) =
((rho &[z1 ∧ z2]_zs) &[(Y #[z1 ∧ z2]_zs) / (y @ys[z1 ∧ z2]_zs)]_ys)"
using assms by(simp add: swapEnv_substEnv)
theorem wls_swapEnv_vsubstEnv:
assumes "wlsEnv rho"
shows "((rho &[y1 // y]_ys) &[z1 ∧ z2]_zs) =
((rho &[z1 ∧ z2]_zs) &[(y1 @ys[z1 ∧ z2]_zs) // (y @ys[z1 ∧ z2]_zs)]_ys)"
using assms by(simp add: swapEnv_vsubstEnv)
theorem wls_psubst_compose:
assumes "wls s X" and "wlsEnv rho" and "wlsEnv rho'"
shows "((X #[rho]) #[rho']) = (X #[(rho &[rho'])])"
using assms by(simp add: psubst_compose)
theorem wls_psubstEnv_compose:
assumes "wlsEnv rho" and "wlsEnv rho'" and "wlsEnv rho''"
shows "((rho &[rho']) &[rho'']) = (rho &[(rho' &[rho''])])"
using assms by(simp add: psubstEnv_compose)
theorem wls_psubst_subst_compose:
assumes "wls s X" and "wls (asSort ys) Y" and "wlsEnv rho"
shows "((X #[Y / y]_ys) #[rho]) = (X #[(rho [y ← (Y #[rho])]_ys)])"
using assms by(simp add: psubst_subst_compose)
theorem wls_psubst_subst_compose_freshEnv:
assumes "wlsEnv rho" and "wls s X" and "wls (asSort ys) Y"
and "freshEnv ys y rho"
shows "((X #[Y / y]_ys) #[rho]) = ((X #[rho]) #[(Y #[rho]) / y]_ys)"
using assms by (simp add: psubst_subst_compose_freshEnv)
theorem wls_psubstEnv_substEnv_compose_freshEnv:
assumes "wlsEnv rho" and "wlsEnv rho'" and "wls (asSort ys) Y"
assumes "freshEnv ys y rho'"
shows "((rho &[Y / y]_ys) &[rho']) = ((rho &[rho']) &[(Y #[rho']) / y]_ys)"
using assms by (simp add: psubstEnv_substEnv_compose_freshEnv)
theorem wls_psubstEnv_substEnv_compose:
assumes "wlsEnv rho" and "wls (asSort ys) Y" and "wlsEnv rho'"
shows "((rho &[Y / y]_ys) &[rho']) = (rho &[(rho' [y ← (Y #[rho'])]_ys)])"
using assms by(simp add: psubstEnv_substEnv_compose)
theorem wls_psubst_vsubst_compose:
assumes "wls s X" and "wlsEnv rho"
shows "((X #[y1 // y]_ys) #[rho]) = (X #[(rho [y ← ((Var ys y1) #[rho])]_ys)])"
using assms by(simp add: psubst_vsubst_compose)
theorem wls_psubstEnv_vsubstEnv_compose:
assumes "wlsEnv rho" and "wlsEnv rho'"
shows "((rho &[y1 // y]_ys) &[rho']) = (rho &[(rho' [y ← ((Var ys y1) #[rho'])]_ys)])"
using assms by(simp add: psubstEnv_vsubstEnv_compose)
theorem wls_subst_psubst_compose:
assumes "wls s X" and "wls (asSort ys) Y" and "wlsEnv rho"
shows "((X #[rho]) #[Y / y]_ys) = (X #[(rho &[Y / y]_ys)])"
using assms by(simp add: subst_psubst_compose)
theorem wls_substEnv_psubstEnv_compose:
assumes "wlsEnv rho" and "wls (asSort ys) Y" and "wlsEnv rho'"
shows "((rho &[rho']) &[Y / y]_ys) = (rho &[(rho' &[Y / y]_ys)])"
using assms by(simp add: substEnv_psubstEnv_compose)
theorem wls_vsubst_psubst_compose:
assumes "wls s X" and "wlsEnv rho"
shows "((X #[rho]) #[y1 // y]_ys) = (X #[(rho &[y1 // y]_ys)])"
using assms by(simp add: vsubst_psubst_compose)
theorem wls_vsubstEnv_psubstEnv_compose:
assumes "wlsEnv rho" and "wlsEnv rho'"
shows "((rho &[rho']) &[y1 // y]_ys) = (rho &[(rho' &[y1 // y]_ys)])"
using assms by(simp add: vsubstEnv_psubstEnv_compose)
theorem wls_subst_compose1:
assumes "wls s X" and "wls (asSort ys) Y1" and "wls (asSort ys) Y2"
shows "((X #[Y1 / y]_ys) #[Y2 / y]_ys) = (X #[(Y1 #[Y2 / y]_ys) / y]_ys)"
using assms by(simp add: subst_compose1)
theorem wls_substEnv_compose1:
assumes "wlsEnv rho" and "wls (asSort ys) Y1" and "wls (asSort ys) Y2"
shows "((rho &[Y1 / y]_ys) &[Y2 / y]_ys) = (rho &[(Y1 #[Y2 / y]_ys) / y]_ys)"
using assms by(simp add: substEnv_compose1)
theorem wls_subst_vsubst_compose1:
assumes "wls s X" and "wls (asSort ys) Y" and "y ≠ y1"
shows "((X #[y1 // y]_ys) #[Y / y]_ys) = (X #[y1 // y]_ys)"
using assms by(simp add: subst_vsubst_compose1)
theorem wls_substEnv_vsubstEnv_compose1:
assumes "wlsEnv rho" and "wls (asSort ys) Y" and "y ≠ y1"
shows "((rho &[y1 // y]_ys) &[Y / y]_ys) = (rho &[y1 // y]_ys)"
using assms by(simp add: substEnv_vsubstEnv_compose1)
theorem wls_vsubst_subst_compose1:
assumes "wls s X" and "wls (asSort ys) Y"
shows "((X #[Y / y]_ys) #[y1 // y]_ys) = (X #[(Y #[y1 // y]_ys) / y]_ys)"
using assms by(simp add: vsubst_subst_compose1)
theorem wls_vsubstEnv_substEnv_compose1:
assumes "wlsEnv rho" and "wls (asSort ys) Y"
shows "((rho &[Y / y]_ys) &[y1 // y]_ys) = (rho &[(Y #[y1 // y]_ys) / y]_ys)"
using assms by(simp add: vsubstEnv_substEnv_compose1)
theorem wls_vsubst_compose1:
assumes "wls s X"
shows "((X #[y1 // y]_ys) #[y2 // y]_ys) = (X #[(y1 @ys[y2 / y]_ys) // y]_ys)"
using assms by(simp add: vsubst_compose1)
theorem wls_vsubstEnv_compose1:
assumes "wlsEnv rho"
shows "((rho &[y1 // y]_ys) &[y2 // y]_ys) = (rho &[(y1 @ys[y2 / y]_ys) // y]_ys)"
using assms by(simp add: vsubstEnv_compose1)
theorem wls_subst_compose2:
assumes "wls s X" and "wls (asSort ys) Y" and "wls (asSort zs) Z"
and "ys ≠ zs ∨ y ≠ z" and fresh: "fresh ys y Z"
shows "((X #[Y / y]_ys) #[Z / z]_zs) = ((X #[Z / z]_zs) #[(Y #[Z / z]_zs) / y]_ys)"
using assms by(simp add: subst_compose2)
theorem wls_substEnv_compose2:
assumes "wlsEnv rho" and "wls (asSort ys) Y" and "wls (asSort zs) Z"
and "ys ≠ zs ∨ y ≠ z" and fresh: "fresh ys y Z"
shows "((rho &[Y / y]_ys) &[Z / z]_zs) = ((rho &[Z / z]_zs) &[(Y #[Z / z]_zs) / y]_ys)"
using assms by(simp add: substEnv_compose2)
theorem wls_subst_vsubst_compose2:
assumes "wls s X" and "wls (asSort zs) Z"
and "ys ≠ zs ∨ y ≠ z" and fresh: "fresh ys y Z"
shows "((X #[y1 // y]_ys) #[Z / z]_zs) = ((X #[Z / z]_zs) #[((Var ys y1) #[Z / z]_zs) / y]_ys)"
using assms by(simp add: subst_vsubst_compose2)
theorem wls_substEnv_vsubstEnv_compose2:
assumes "wlsEnv rho" and "wls (asSort zs) Z"
and "ys ≠ zs ∨ y ≠ z" and fresh: "fresh ys y Z"
shows "((rho &[y1 // y]_ys) &[Z / z]_zs) = ((rho &[Z / z]_zs) &[((Var ys y1) #[Z / z]_zs) / y]_ys)"
using assms by(simp add: substEnv_vsubstEnv_compose2)
theorem wls_vsubst_subst_compose2:
assumes "wls s X" and "wls (asSort ys) Y"
and "ys ≠ zs ∨ y ∉ {z,z1}"
shows "((X #[Y / y]_ys) #[z1 // z]_zs) = ((X #[z1 // z]_zs) #[(Y #[z1 // z]_zs) / y]_ys)"
using assms by(simp add: vsubst_subst_compose2)
theorem wls_vsubstEnv_substEnv_compose2:
assumes "wlsEnv rho" and "wls (asSort ys) Y"
and "ys ≠ zs ∨ y ∉ {z,z1}"
shows "((rho &[Y / y]_ys) &[z1 // z]_zs) = ((rho &[z1 // z]_zs) &[(Y #[z1 // z]_zs) / y]_ys)"
using assms by(simp add: vsubstEnv_substEnv_compose2)
theorem wls_vsubst_compose2:
assumes "wls s X"
and "ys ≠ zs ∨ y ∉ {z,z1}"
shows "((X #[y1 // y]_ys) #[z1 // z]_zs) = ((X #[z1 // z]_zs) #[(y1 @ys[z1 / z]_zs) // y]_ys)"
using assms by(simp add: vsubst_compose2)
theorem wls_vsubstEnv_compose2:
assumes "wlsEnv rho"
and "ys ≠ zs ∨ y ∉ {z,z1}"
shows "((rho &[y1 // y]_ys) &[z1 // z]_zs) =
((rho &[z1 // z]_zs) &[(y1 @ys[z1 / z]_zs) // y]_ys)"
using assms by(simp add: vsubstEnv_compose2)
subsubsection ‹Properties specific to variable-for-variable substitution›
theorem wls_vsubst_ident[simp]:
assumes "wls s X"
shows "(X #[z // z]_zs) = X"
using assms by(simp add: vsubst_ident)
theorem wls_subst_ident[simp]:
assumes "wls s X"
shows "(X #[(Var zs z) / z]_zs) = X"
using assms by simp
theorem wls_vsubst_eq_swap:
assumes "wls s X" and "y1 = y2 ∨ fresh ys y1 X"
shows "(X #[y1 // y2]_ys) = (X #[y1 ∧ y2]_ys)"
using assms by(simp add: vsubst_eq_swap)
theorem wls_skel_vsubst:
assumes "wls s X"
shows "skel (X #[y1 // y2]_ys) = skel X"
using assms by(simp add: skel_vsubst)
theorem wls_subst_vsubst_trans:
assumes "wls s X" and "wls (asSort ys) Y" and "fresh ys y1 X"
shows "((X #[y1 // y]_ys) #[Y / y1]_ys) = (X #[Y / y]_ys)"
using assms by (simp add: subst_vsubst_trans)
theorem wls_vsubst_trans:
assumes "wls s X" and "fresh ys y1 X"
shows "((X #[y1 // y]_ys) #[y2 // y1]_ys) = (X #[y2 // y]_ys)"
using assms by (simp add: vsubst_trans)
theorem wls_vsubst_commute:
assumes "wls s X"
and "xs ≠ xs' ∨ {x,y} ∩ {x',y'} = {}" and "fresh xs x X" and "fresh xs' x' X"
shows "((X #[x // y]_xs) #[x' // y']_xs') = ((X #[x' // y']_xs') #[x // y]_xs)"
using assms by(simp add: vsubst_commute)
theorem wls_induct[case_names Var Op Abs]:
assumes
Var: "⋀ xs x. phi (asSort xs) (Var xs x)" and
Op:
"⋀ delta inp binp.
⟦wlsInp delta inp; wlsBinp delta binp;
liftAll2 phi (arOf delta) inp; liftAll2 phiAbs (barOf delta) binp⟧
⟹ phi (stOf delta) (Op delta inp binp)" and
Abs:
"⋀ s xs x X.
⟦isInBar (xs,s); wls s X;
⋀ Y. (X,Y) ∈ swapped ⟹ phi s Y;
⋀ ys y1 y2. phi s (X #[y1 // y2]_ys);
⋀ Y. ⟦wls s Y; skel Y = skel X⟧ ⟹ phi s Y⟧
⟹ phiAbs (xs,s) (Abs xs x X)"
shows
"(wls s X ⟶ phi s X) ∧
(wlsAbs (xs,s') A ⟶ phiAbs (xs,s') A)"
apply(induction rule: wls_templateInduct
[of "λs. swapped ∪ {(X, X #[y1 // y2]_ys)| X ys y1 y2. True}
∪ {(X,Y). wls s Y ∧ skel Y = skel X}"])
by (auto simp add: assms swapped_preserves_wls swapped_skel wls_skel_vsubst
intro!: Abs)
theorem wls_Abs_vsubst_all_aux:
assumes "wls s X" and "wls s X'"
shows
"(Abs xs x X = Abs xs x' X') =
(∀ y. (y = x ∨ fresh xs y X) ∧ (y = x' ∨ fresh xs y X') ⟶
(X #[y // x]_xs) = (X' #[y // x']_xs))"
using assms wls_Abs_swap_all by (simp add: wls_vsubst_eq_swap)
theorem wls_Abs_vsubst_ex:
assumes "wls s X" and "wls s X'"
shows
"(Abs xs x X = Abs xs x' X') =
(∃ y. y ∉ {x,x'} ∧ fresh xs y X ∧ fresh xs y X' ∧
(X #[y // x]_xs) = (X' #[y // x']_xs))"
proof-
let ?phi = "λ f y. y ∉ {x,x'} ∧ fresh xs y X ∧ fresh xs y X'
∧ (f xs y x X) = (f xs y x' X')"
{assume "Abs xs x X = Abs xs x' X'"
then obtain y where "?phi swap y" using assms wls_Abs_swap_ex by auto
hence "?phi (λ xs y x X. (X #[y // x]_xs)) y"
using assms by(simp add: wls_vsubst_eq_swap)
hence "∃ y. ?phi (λ xs y x X. (X #[y // x]_xs)) y" by auto
}
moreover
{fix y assume "?phi (λ xs y x X. (X #[y // x]_xs)) y"
hence "?phi swap y" using assms by(auto simp add: wls_vsubst_eq_swap)
hence "Abs xs x X = Abs xs x' X'" using assms wls_Abs_swap_ex by auto
}
ultimately show ?thesis by auto
qed
theorem wls_Abs_vsubst_all:
assumes "wls s X" and "wls s X'"
shows
"(Abs xs x X = Abs xs x' X') =
(∀ y. (X #[y // x]_xs) = (X' #[y // x']_xs))"
proof(rule iffI, clarify)
assume "∀ y. (X #[y // x]_xs) = (X' #[y // x']_xs)"
thus "Abs xs x X = Abs xs x' X'"
using assms by(auto simp add: wls_Abs_vsubst_all_aux)
next
fix y
assume "Abs xs x X = Abs xs x' X'"
then obtain z where z_fresh: "fresh xs z X ∧ fresh xs z X'"
and "(X #[z // x]_xs) = (X' #[z // x']_xs)"
using assms by(auto simp add: wls_Abs_vsubst_ex)
hence "((X #[z // x]_xs) #[y // z]_xs) = ((X' #[z // x']_xs) #[y // z]_xs)" by simp
thus "(X #[y // x]_xs) = (X' #[y // x']_xs)"
using assms z_fresh wls_vsubst_trans by auto
qed
theorem wls_Abs_subst_all:
assumes "wls s X" and "wls s X'"
shows
"(Abs xs x X = Abs xs x' X') =
(∀ Y. wls (asSort xs) Y ⟶ (X #[Y / x]_xs) = (X' #[Y / x']_xs))"
proof(rule iffI, clarify)
assume "∀ Y. wls (asSort xs) Y ⟶ (X #[Y / x]_xs) = (X' #[Y / x']_xs)"
hence "∀ y. (X #[y // x]_xs) = (X' #[y // x']_xs)"
unfolding vsubst_def by simp
thus "Abs xs x X = Abs xs x' X'"
using assms wls_Abs_vsubst_all by auto
next
fix Y assume Y: "wls (asSort xs) Y"
assume "Abs xs x X = Abs xs x' X'"
then obtain z where z_fresh: "fresh xs z X ∧ fresh xs z X'"
and "(X #[z // x]_xs) = (X' #[z // x']_xs)"
using assms by(auto simp add: wls_Abs_vsubst_ex)
hence "((X #[z // x]_xs) #[Y / z]_xs) = ((X' #[z // x']_xs) #[Y / z]_xs)" by simp
thus "(X #[Y / x]_xs) = (X' #[Y / x']_xs)"
using assms z_fresh Y wls_subst_vsubst_trans by auto
qed
lemma Abs_inj_fresh[simp]:
assumes X: "wls s X" and X': "wls s X'"
and fresh_X: "fresh ys x X" and fresh_X': "fresh ys x' X'"
and eq: "Abs ys x X = Abs ys x' X'"
shows "X = X'"
proof-
obtain z where "(X #[z // x]_ys) = (X' #[z // x']_ys)"
using X X' eq by(auto simp add: wls_Abs_vsubst_ex)
thus ?thesis using X X' fresh_X fresh_X' by simp
qed
theorem wls_Abs_vsubst_cong:
assumes "wls s X" and "wls s X'"
and "fresh xs y X" and "fresh xs y X'" and "(X #[y // x]_xs) = (X' #[y // x']_xs)"
shows "Abs xs x X = Abs xs x' X'"
using assms by (intro wls_Abs_swap_cong) (auto simp: wls_vsubst_eq_swap)
theorem wls_Abs_vsubst_fresh[simp]:
assumes "wls s X" and "fresh xs x' X"
shows "Abs xs x' (X #[x' // x]_xs) = Abs xs x X"
using assms by(simp add: wls_vsubst_eq_swap)
theorem wls_Abs_subst_Var_fresh[simp]:
assumes "wls s X" and "fresh xs x' X"
shows "Abs xs x' (subst xs (Var xs x') x X) = Abs xs x X"
using assms wls_Abs_vsubst_fresh unfolding vsubst_def by simp
theorem wls_Abs_vsubst_congSTR:
assumes "wls s X" and "wls s X'"
and "y = x ∨ fresh xs y X" "y = x' ∨ fresh xs y X'"
and "(X #[y // x]_xs) = (X' #[y // x']_xs)"
shows "Abs xs x X = Abs xs x' X'"
by (metis assms wls_Abs_vsubst_fresh wls_vsubst_ident)
subsubsection ‹Abstraction versions of the properties›
theorem wls_psubstAbs_idEnv[simp]:
"wlsAbs (us,s) A ⟹ (A $[idEnv]) = A"
by simp
theorem wls_freshAbs_psubstAbs:
assumes "wlsAbs (us,s) A" and "wlsEnv rho"
shows
"freshAbs zs z (A $[rho]) =
(∀ ys y. freshAbs ys y A ∨ freshImEnvAt zs z rho ys y)"
using assms by(simp add: freshAbs_psubstAbs)
theorem wls_freshAbs_psubstAbs_E1:
assumes "wlsAbs (us,s) A" and "wlsEnv rho"
and "rho ys y = None" and "freshAbs zs z (A $[rho])"
shows "freshAbs ys y A ∨ (ys ≠ zs ∨ y ≠ z)"
using assms freshAbs_psubstAbs_E1[of A rho ys y zs z] by simp
theorem wls_freshAbs_psubstAbs_E2:
assumes "wlsAbs (us,s) A" and "wlsEnv rho"
and "rho ys y = Some Y" and "freshAbs zs z (A $[rho])"
shows "freshAbs ys y A ∨ fresh zs z Y"
using assms freshAbs_psubstAbs_E2[of A rho ys y Y zs z] by simp
theorem wls_freshAbs_psubstAbs_I1:
assumes "wlsAbs (us,s) A" and "wlsEnv rho"
and "freshAbs zs z A" and "freshEnv zs z rho"
shows "freshAbs zs z (A $[rho])"
using assms by(simp add: freshAbs_psubstAbs_I1)
theorem wls_freshAbs_psubstAbs_I:
assumes "wlsAbs (us,s) A" and "wlsEnv rho"
and "rho zs z = None ⟹ freshAbs zs z A" and
"⋀ ys y Y. rho ys y = Some Y ⟹ freshAbs ys y A ∨ fresh zs z Y"
shows "freshAbs zs z (A $[rho])"
using assms by(simp add: freshAbs_psubstAbs_I)
theorem wls_freshAbs_substAbs:
assumes "wlsAbs (us,s) A" and "wls (asSort ys) Y"
shows "freshAbs zs z (A $[Y / y]_ys) =
(((zs = ys ∧ z = y) ∨ freshAbs zs z A) ∧ (freshAbs ys y A ∨ fresh zs z Y))"
using assms by(simp add: freshAbs_substAbs)
theorem wls_freshAbs_vsubstAbs:
assumes "wlsAbs (us,s) A"
shows "freshAbs zs z (A $[y1 // y]_ys) =
(((zs = ys ∧ z = y) ∨ freshAbs zs z A) ∧
(freshAbs ys y A ∨ (zs ≠ ys ∨ z ≠ y1)))"
using assms by(simp add: freshAbs_vsubstAbs)
theorem wls_substAbs_preserves_freshAbs:
assumes "wlsAbs (us,s) A" and "wls (asSort ys) Y"
and "freshAbs zs z A" and "fresh zs z Y"
shows "freshAbs zs z (A $[Y / y]_ys)"
using assms by(simp add: substAbs_preserves_freshAbs)
theorem wls_vsubstAbs_preserves_freshAbs:
assumes "wlsAbs (us,s) A"
and "freshAbs zs z A" and "zs ≠ ys ∨ z ≠ y1"
shows "freshAbs zs z (A $[y1 // y]_ys)"
using assms by(simp add: vsubstAbs_preserves_freshAbs)
theorem wls_fresh_freshAbs_substAbs[simp]:
assumes "wls (asSort ys) Y" and "wlsAbs (us,s) A"
and "fresh ys y Y"
shows "freshAbs ys y (A $[Y / y]_ys)"
using assms by simp
theorem wls_diff_freshAbs_vsubstAbs[simp]:
assumes "wlsAbs (us,s) A"
and "y ≠ y1"
shows "freshAbs ys y (A $[y1 // y]_ys)"
using assms by simp
theorem wls_freshAbs_substAbs_E1:
assumes "wlsAbs (us,s) A" and "wls (asSort ys) Y"
and "freshAbs zs z (A $[Y / y]_ys)" and "z ≠ y ∨ zs ≠ ys"
shows "freshAbs zs z A"
using assms freshAbs_substAbs_E1[of A Y zs z ys y] by auto
theorem wls_freshAbs_vsubstAbs_E1:
assumes "wlsAbs (us,s) A"
and "freshAbs zs z (A $[y1 // y]_ys)" and "z ≠ y ∨ zs ≠ ys"
shows "freshAbs zs z A"
using assms freshAbs_vsubstAbs_E1[of A zs z ys y1 y] by auto
theorem wls_freshAbs_substAbs_E2:
assumes "wlsAbs (us,s) A" and "wls (asSort ys) Y"
and "freshAbs zs z (A $[Y / y]_ys)"
shows "freshAbs ys y A ∨ fresh zs z Y"
using assms freshAbs_substAbs_E2[of A Y zs z ys] by simp
theorem wls_freshAbs_vsubstAbs_E2:
assumes "wlsAbs (us,s) A"
and "freshAbs zs z (A $[y1 // y]_ys)"
shows "freshAbs ys y A ∨ zs ≠ ys ∨ z ≠ y1"
using assms freshAbs_vsubstAbs_E2[of A zs z ys y1 y] by simp
theorem wls_psubstAbs_cong[fundef_cong]:
assumes "wlsAbs (us,s) A" and "wlsEnv rho" and "wlsEnv rho'"
and "⋀ ys y. freshAbs ys y A ∨ rho ys y = rho' ys y"
shows "(A $[rho]) = (A $[rho'])"
using assms by(simp add: psubstAbs_cong)
theorem wls_freshAbs_psubstAbs_updEnv:
assumes "wls (asSort xs) X" and "wlsAbs (us,s) A" and "wlsEnv rho"
and "freshAbs xs x A"
shows "(A $[rho [x ← X]_xs]) = (A $[rho])"
using assms by(simp add: freshAbs_psubstAbs_updEnv)
lemma wls_freshEnv_psubstAbs_ident[simp]:
assumes "wlsAbs (us,s) A" and "wlsEnv rho"
and "⋀ zs z. freshEnv zs z rho ∨ freshAbs zs z A"
shows "(A $[rho]) = A"
using assms by simp
theorem wls_freshAbs_substAbs_ident[simp]:
assumes "wls (asSort xs) X" and "wlsAbs (us,s) A" and "freshAbs xs x A"
shows "(A $[X / x]_xs) = A"
using assms by simp
theorem wls_substAbs_Abs[simp]:
assumes "wls s X" and "wls (asSort xs) Y"
shows "((Abs xs x X) $[Y / x]_xs) = Abs xs x X"
using assms by simp
theorem wls_freshAbs_vsubstAbs_ident[simp]:
assumes "wlsAbs (us,s) A" and "freshAbs xs x A"
shows "(A $[x1 // x]_xs) = A"
using assms by(simp add: freshAbs_vsubstAbs_ident)
theorem wls_swapAbs_psubstAbs:
assumes "wlsAbs (us,s) A" and "wlsEnv rho"
shows "((A $[rho]) $[z1 ∧ z2]_zs) = ((A $[z1 ∧ z2]_zs) $[rho &[z1 ∧ z2]_zs])"
using assms by(simp add: swapAbs_psubstAbs)
theorem wls_swapAbs_substAbs:
assumes "wlsAbs (us,s) A" and "wls (asSort ys) Y"
shows "((A $[Y / y]_ys) $[z1 ∧ z2]_zs) =
((A $[z1 ∧ z2]_zs) $[(Y #[z1 ∧ z2]_zs) / (y @ys[z1 ∧ z2]_zs)]_ys)"
using assms by(simp add: swapAbs_substAbs)
theorem wls_swapAbs_vsubstAbs:
assumes "wlsAbs (us,s) A"
shows "((A $[y1 // y]_ys) $[z1 ∧ z2]_zs) =
((A $[z1 ∧ z2]_zs) $[(y1 @ys[z1 ∧ z2]_zs) // (y @ys[z1 ∧ z2]_zs)]_ys)"
using assms by(simp add: swapAbs_vsubstAbs)
theorem wls_psubstAbs_compose:
assumes "wlsAbs (us,s) A" and "wlsEnv rho" and "wlsEnv rho'"
shows "((A $[rho]) $[rho']) = (A $[(rho &[rho'])])"
using assms by(simp add: psubstAbs_compose)
theorem wls_psubstAbs_substAbs_compose:
assumes "wlsAbs (us,s) A" and "wls (asSort ys) Y" and "wlsEnv rho"
shows "((A $[Y / y]_ys) $[rho]) = (A $[(rho [y ← (Y #[rho])]_ys)])"
using assms by(simp add: psubstAbs_substAbs_compose)
theorem wls_psubstAbs_substAbs_compose_freshEnv:
assumes "wlsEnv rho" and "wlsAbs (us,s) A" and "wls (asSort ys) Y"
assumes "freshEnv ys y rho"
shows "((A $[Y / y]_ys) $[rho]) = ((A $[rho]) $[(Y #[rho]) / y]_ys)"
using assms by (simp add: psubstAbs_substAbs_compose_freshEnv)
theorem wls_psubstAbs_vsubstAbs_compose:
assumes "wlsAbs (us,s) A" and "wlsEnv rho"
shows "((A $[y1 // y]_ys) $[rho]) = (A $[(rho [y ← ((Var ys y1) #[rho])]_ys)])"
using assms by(simp add: psubstAbs_vsubstAbs_compose)
theorem wls_substAbs_psubstAbs_compose:
assumes "wlsAbs (us,s) A" and "wls (asSort ys) Y" and "wlsEnv rho"
shows "((A $[rho]) $[Y / y]_ys) = (A $[(rho &[Y / y]_ys)])"
using assms by(simp add: substAbs_psubstAbs_compose)
theorem wls_vsubstAbs_psubstAbs_compose:
assumes "wlsAbs (us,s) A" and "wlsEnv rho"
shows "((A $[rho]) $[y1 // y]_ys) = (A $[(rho &[y1 // y]_ys)])"
using assms by(simp add: vsubstAbs_psubstAbs_compose)
theorem wls_substAbs_compose1:
assumes "wlsAbs (us,s) A" and "wls (asSort ys) Y1" and "wls (asSort ys) Y2"
shows "((A $[Y1 / y]_ys) $[Y2 / y]_ys) = (A $[(Y1 #[Y2 / y]_ys) / y]_ys)"
using assms by(simp add: substAbs_compose1)
theorem wls_substAbs_vsubstAbs_compose1:
assumes "wlsAbs (us,s) A" and "wls (asSort ys) Y" and "y ≠ y1"
shows "((A $[y1 // y]_ys) $[Y / y]_ys) = (A $[y1 // y]_ys)"
using assms by(simp add: substAbs_vsubstAbs_compose1)
theorem wls_vsubstAbs_substAbs_compose1:
assumes "wlsAbs (us,s) A" and "wls (asSort ys) Y"
shows "((A $[Y / y]_ys) $[y1 // y]_ys) = (A $[(Y #[y1 // y]_ys) / y]_ys)"
using assms by(simp add: vsubstAbs_substAbs_compose1)
theorem wls_vsubstAbs_compose1:
assumes "wlsAbs (us,s) A"
shows "((A $[y1 // y]_ys) $[y2 // y]_ys) = (A $[(y1 @ys[y2 / y]_ys) // y]_ys)"
using assms by(simp add: vsubstAbs_compose1)
theorem wls_substAbs_compose2:
assumes "wlsAbs (us,s) A" and "wls (asSort ys) Y" and "wls (asSort zs) Z"
and "ys ≠ zs ∨ y ≠ z" and fresh: "fresh ys y Z"
shows "((A $[Y / y]_ys) $[Z / z]_zs) = ((A $[Z / z]_zs) $[(Y #[Z / z]_zs) / y]_ys)"
using assms by(simp add: substAbs_compose2)
theorem wls_substAbs_vsubstAbs_compose2:
assumes "wlsAbs (us,s) A" and "wls (asSort zs) Z"
and "ys ≠ zs ∨ y ≠ z" and fresh: "fresh ys y Z"
shows "((A $[y1 // y]_ys) $[Z / z]_zs) = ((A $[Z / z]_zs) $[((Var ys y1) #[Z / z]_zs) / y]_ys)"
using assms by(simp add: substAbs_vsubstAbs_compose2)
theorem wls_vsubstAbs_substAbs_compose2:
assumes "wlsAbs (us,s) A" and "wls (asSort ys) Y"
and "ys ≠ zs ∨ y ∉ {z,z1}"
shows "((A $[Y / y]_ys) $[z1 // z]_zs) = ((A $[z1 // z]_zs) $[(Y #[z1 // z]_zs) / y]_ys)"
using assms by(simp add: vsubstAbs_substAbs_compose2)
theorem wls_vsubstAbs_compose2:
assumes "wlsAbs (us,s) A"
and "ys ≠ zs ∨ y ∉ {z,z1}"
shows "((A $[y1 // y]_ys) $[z1 // z]_zs) = ((A $[z1 // z]_zs) $[(y1 @ys[z1 / z]_zs) // y]_ys)"
using assms by(simp add: vsubstAbs_compose2)
theorem wls_vsubstAbs_ident[simp]:
assumes "wlsAbs (us,s) A"
shows "(A $[z // z]_zs) = A"
using assms by(simp add: vsubstAbs_ident)
theorem wls_substAbs_ident[simp]:
assumes "wlsAbs (us,s) A"
shows "(A $[(Var zs z) / z]_zs) = A"
using assms by simp
theorem wls_vsubstAbs_eq_swapAbs:
assumes "wlsAbs (us,s) A" and "y1 = y2 ∨ freshAbs ys y1 A"
shows "(A $[y1 // y2]_ys) = (A $[y1 ∧ y2]_ys)"
using assms vsubstAll_swapAll[of "Par [y1, y2] [] [] []" _ _ A]
unfolding goodPar_def by auto
theorem wls_skelAbs_vsubstAbs:
assumes "wlsAbs (us,s) A"
shows "skelAbs (A $[y1 // y2]_ys) = skelAbs A"
using assms by(simp add: skelAbs_vsubstAbs)
theorem wls_substAbs_vsubstAbs_trans:
assumes "wlsAbs (us,s) A" and "wls (asSort ys) Y" and "freshAbs ys y1 A"
shows "((A $[y1 // y]_ys) $[Y / y1]_ys) = (A $[Y / y]_ys)"
using assms by(simp add: substAbs_vsubstAbs_trans)
theorem wls_vsubstAbs_trans:
assumes "wlsAbs (us,s) A" and "freshAbs ys y1 A"
shows "((A $[y1 // y]_ys) $[y2 // y1]_ys) = (A $[y2 // y]_ys)"
using assms by(simp add: vsubstAbs_trans)
theorem wls_vsubstAbs_commute:
assumes "wlsAbs (us,s) A"
and "xs ≠ xs' ∨ {x,y} ∩ {x',y'} = {}" and "freshAbs xs x A" and "freshAbs xs' x' A"
shows "((A $[x // y]_xs) $[x' // y']_xs') = ((A $[x' // y']_xs') $[x // y]_xs)"
proof-
have "freshAbs xs' x' (A $[x // y]_xs)"
using assms by(auto simp: vsubstAbs_preserves_freshAbs)
moreover have "freshAbs xs x (A $[x' // y']_xs')"
using assms by(auto simp: vsubstAbs_preserves_freshAbs)
ultimately show ?thesis using assms
by (auto simp: vsubstAbs_eq_swapAbs intro!: wls_swapAbs_commute)
qed
lemmas wls_psubstAll_freshAll_otherSimps =
wls_psubst_idEnv wls_psubstEnv_idEnv_id wls_psubstAbs_idEnv
wls_freshEnv_psubst_ident wls_freshEnv_psubstAbs_ident
lemmas wls_substAll_freshAll_otherSimps =
wls_fresh_fresh_subst wls_fresh_subst_ident wls_fresh_substEnv_updEnv wls_subst_ident
wls_fresh_freshAbs_substAbs wls_freshAbs_substAbs_ident wls_substAbs_ident
wls_Abs_subst_Var_fresh
lemmas wls_vsubstAll_freshAll_otherSimps =
wls_diff_fresh_vsubst wls_fresh_vsubst_ident wls_fresh_vsubstEnv_updEnv wls_vsubst_ident
wls_diff_freshAbs_vsubstAbs wls_freshAbs_vsubstAbs_ident wls_vsubstAbs_ident
wls_Abs_vsubst_fresh
lemmas wls_allOpers_otherSimps =
wls_swapAll_freshAll_otherSimps
wls_psubstAll_freshAll_otherSimps
wls_substAll_freshAll_otherSimps
wls_vsubstAll_freshAll_otherSimps
subsection ‹Operators for down-casting and case-analyzing well-sorted items›
text‹The features developed here may occasionally turn out more convenient than obtaining
the desired effect by hand, via the corresponding nchotomies.
E.g., when we want to perform the case-analysis uniformly, as part of a
function definition, the operators defined in the subsection save some tedious
definitions and proofs pertaining to Hilbert choice.›
subsubsection ‹For terms›
definition isVar where
"isVar s (X :: ('index,'bindex,'varSort,'var,'opSym)term) ==
∃ xs x. s = asSort xs ∧ X = Var xs x"
definition castVar where
"castVar s (X :: ('index,'bindex,'varSort,'var,'opSym)term) ==
SOME xs_x. s = asSort (fst xs_x) ∧ X = Var (fst xs_x) (snd xs_x)"
definition isOp where
"isOp s X ≡
∃ delta inp binp.
wlsInp delta inp ∧ wlsBinp delta binp ∧ s = stOf delta ∧ X = Op delta inp binp"
definition castOp where
"castOp s X ≡
SOME delta_inp_binp.
wlsInp (fst3 delta_inp_binp) (snd3 delta_inp_binp) ∧
wlsBinp (fst3 delta_inp_binp) (trd3 delta_inp_binp) ∧
s = stOf (fst3 delta_inp_binp) ∧
X = Op (fst3 delta_inp_binp) (snd3 delta_inp_binp) (trd3 delta_inp_binp)"
definition sortTermCase where
"sortTermCase fVar fOp s X ≡
if isVar s X then fVar (fst (castVar s X)) (snd (castVar s X))
else if isOp s X then fOp (fst3 (castOp s X)) (snd3 (castOp s X)) (trd3 (castOp s X))
else undefined"
lemma isVar_asSort_Var[simp]:
"isVar (asSort xs) (Var xs x)"
unfolding isVar_def by auto
lemma not_isVar_Op[simp]:
"¬ isVar s (Op delta inp binp)"
unfolding isVar_def by auto
lemma isVar_imp_wls:
"isVar s X ⟹ wls s X"
unfolding isVar_def by auto
lemmas isVar_simps =
isVar_asSort_Var not_isVar_Op
lemma castVar_asSort_Var[simp]:
"castVar (asSort xs) (Var xs x) = (xs,x)"
unfolding castVar_def by (rule some_equality) auto
lemma isVar_castVar:
assumes "isVar s X"
shows "asSort (fst (castVar s X)) = s ∧
Var (fst (castVar s X)) (snd (castVar s X)) = X"
using assms isVar_def by auto
lemma asSort_castVar[simp]:
"isVar s X ⟹ asSort (fst (castVar s X)) = s"
using isVar_castVar by auto
lemma Var_castVar[simp]:
"isVar s X ⟹ Var (fst (castVar s X)) (snd (castVar s X)) = X"
using isVar_castVar by auto
lemma castVar_inj[simp]:
assumes *: "isVar s X" and **: "isVar s' X'"
shows "(castVar s X = castVar s' X') = (s = s' ∧ X = X')"
using assms Var_castVar asSort_castVar by fastforce
lemmas castVar_simps =
castVar_asSort_Var
asSort_castVar Var_castVar castVar_inj
lemma isOp_stOf_Op[simp]:
"⟦wlsInp delta inp; wlsBinp delta binp⟧
⟹ isOp (stOf delta) (Op delta inp binp)"
unfolding isOp_def by auto
lemma not_isOp_Var[simp]:
"¬ isOp s (Var xs X)"
unfolding isOp_def by auto
lemma isOp_imp_wls:
"isOp s X ⟹ wls s X"
unfolding isOp_def by auto
lemmas isOp_simps =
isOp_stOf_Op not_isOp_Var
lemma castOp_stOf_Op[simp]:
assumes "wlsInp delta inp" and "wlsBinp delta binp"
shows "castOp (stOf delta) (Op delta inp binp) = (delta,inp,binp)"
using assms unfolding castOp_def by (intro some_equality) auto
lemma isOp_castOp:
assumes "isOp s X"
shows "wlsInp (fst3 (castOp s X)) (snd3 (castOp s X)) ∧
wlsBinp (fst3 (castOp s X)) (trd3 (castOp s X)) ∧
stOf (fst3 (castOp s X)) = s ∧
Op (fst3 (castOp s X)) (snd3 (castOp s X)) (trd3 (castOp s X)) = X"
proof-
let ?phi = "λ DIB. wlsInp (fst3 DIB) (snd3 DIB) ∧
wlsBinp (fst3 DIB) (trd3 DIB) ∧
s = stOf (fst3 DIB) ∧
X = Op (fst3 DIB) (snd3 DIB) (trd3 DIB)"
obtain delta inp binp where "?phi (delta,inp,binp)"
using assms unfolding isOp_def by auto
hence "?phi (castOp s X)" using someI[of ?phi] by simp
thus ?thesis by simp
qed
lemma wlsInp_castOp[simp]:
"isOp s X ⟹ wlsInp (fst3 (castOp s X)) (snd3 (castOp s X))"
using isOp_castOp by auto
lemma wlsBinp_castOp[simp]:
"isOp s X ⟹ wlsBinp (fst3 (castOp s X)) (trd3 (castOp s X))"
using isOp_castOp by auto
lemma stOf_castOp[simp]:
"isOp s X ⟹ stOf (fst3 (castOp s X)) = s"
using isOp_castOp by auto
lemma Op_castOp[simp]:
"isOp s X ⟹
Op (fst3 (castOp s X)) (snd3 (castOp s X)) (trd3 (castOp s X)) = X"
using isOp_castOp by auto
lemma castOp_inj[simp]:
assumes "isOp s X" and "isOp s' X'"
shows "(castOp s X = castOp s' X') = (s = s' ∧ X = X')"
using assms Op_castOp stOf_castOp by fastforce
lemmas castOp_simps =
castOp_stOf_Op wlsInp_castOp wlsBinp_castOp
stOf_castOp Op_castOp castOp_inj
lemma not_isVar_isOp:
"¬ (isVar s X ∧ isOp s X)"
unfolding isVar_def isOp_def by auto
lemma isVar_or_isOp:
"wls s X ⟹ isVar s X ∨ isOp s X"
by(erule wls_cases) auto
lemma sortTermCase_asSort_Var_simp[simp]:
"sortTermCase fVar fOp (asSort xs) (Var xs x) = fVar xs x"
unfolding sortTermCase_def by auto
lemma sortTermCase_stOf_Op_simp[simp]:
"⟦wlsInp delta inp; wlsBinp delta binp⟧ ⟹
sortTermCase fVar fOp (stOf delta) (Op delta inp binp) = fOp delta inp binp"
unfolding sortTermCase_def by auto
lemma sortTermCase_cong[fundef_cong]:
assumes "⋀ xs x. fVar xs x = gVar xs x"
and "⋀ delta inp binp. ⟦wlsInp delta inp; wlsInp delta inp⟧
⟹ fOp delta inp binp = gOp delta inp binp"
shows "wls s X ⟹
sortTermCase fVar fOp s X = sortTermCase gVar gOp s X"
apply(erule wls_cases) using assms by auto
lemmas sortTermCase_simps =
sortTermCase_asSort_Var_simp
sortTermCase_stOf_Op_simp
lemmas term_cast_simps =
isOp_simps castOp_simps sortTermCase_simps
subsubsection ‹For abstractions›
text ‹Here, the situation will be different than that of terms, since:
\\- an abstraction can only be built using ``Abs", hence we need no ``is" operators;
\\- the constructor ``Abs" for abstractions is not injective, so need a more subtle condition
on the case-analysis operator.
Yet another difference is that when casting an abstraction ``A" such that ``wlsAbs (xs,s) A",
we need to cast only the value ``A", and not the sorting part``xs s", since the latter
already contains the desired information. Consequently, below, in the arguments for the case-analysis
operator, the sorts ``xs s" come before the function ``f", and the latter doesnot take sorts into account.›
definition castAbs where
"castAbs xs s A ≡ SOME x_X. wls s (snd x_X) ∧ A = Abs xs (fst x_X) (snd x_X)"
definition absCase where
"absCase xs s f A ≡ if wlsAbs (xs,s) A then f (fst (castAbs xs s A)) (snd (castAbs xs s A)) else undefined"
definition compatAbsSwap where
"compatAbsSwap xs s f ≡
∀ x X x' X'. (∀ y. (y = x ∨ fresh xs y X) ∧ (y = x' ∨ fresh xs y X')
⟶ (X #[y ∧ x]_xs) = (X' #[y ∧ x']_xs))
⟶ f x X = f x' X'"
definition compatAbsSubst where
"compatAbsSubst xs s f ≡
∀ x X x' X'. (∀ Y. wls (asSort xs) Y ⟶ (X #[Y / x]_xs) = (X' #[Y / x']_xs))
⟶ f x X = f x' X'"
definition compatAbsVsubst where
"compatAbsVsubst xs s f ≡
∀ x X x' X'. (∀ y. (X #[y // x]_xs) = (X' #[y // x']_xs))
⟶ f x X = f x' X'"
lemma wlsAbs_castAbs:
assumes "wlsAbs (xs,s) A"
shows "wls s (snd (castAbs xs s A)) ∧
Abs xs (fst (castAbs xs s A)) (snd (castAbs xs s A)) = A"
proof-
let ?phi = "λ x_X. wls s (snd x_X) ∧
A = Abs xs (fst x_X) (snd x_X)"
obtain x X where "?phi (x,X)" using assms wlsAbs_nchotomy[of xs s A] by auto
hence "?phi (castAbs xs s A)" unfolding castAbs_def using someI[of ?phi] by auto
thus ?thesis by simp
qed
lemma wls_castAbs[simp]:
"wlsAbs (xs,s) A ⟹ wls s (snd (castAbs xs s A))"
using wlsAbs_castAbs by auto
lemma Abs_castAbs[simp]:
"wlsAbs (xs,s) A ⟹ Abs xs (fst (castAbs xs s A)) (snd (castAbs xs s A)) = A"
using wlsAbs_castAbs by auto
lemma castAbs_Abs_swap:
assumes "isInBar (xs,s)" and X: "wls s X"
and yxX: "y = x ∨ fresh xs y X" and yx'X': "y = x' ∨ fresh xs y X'"
and *: "castAbs xs s (Abs xs x X) = (x',X')"
shows "(X #[y ∧ x]_xs) = (X' #[y ∧ x']_xs)"
proof-
have "wlsAbs (xs,s) (Abs xs x X)" using assms by simp
moreover
have "x' = fst (castAbs xs s (Abs xs x X))" and
"X' = snd (castAbs xs s (Abs xs x X))" using * by auto
ultimately
have "wls s X'" and "Abs xs x X = Abs xs x' X'" by auto
thus ?thesis using yxX yx'X' X by(auto simp add: wls_Abs_swap_all)
qed
lemma castAbs_Abs_subst:
assumes isInBar: "isInBar (xs,s)"
and X: "wls s X" and Y: "wls (asSort xs) Y"
and *: "castAbs xs s (Abs xs x X) = (x',X')"
shows "(X #[Y / x]_xs) = (X' #[Y / x']_xs)"
proof-
have "wlsAbs (xs,s) (Abs xs x X)" using isInBar X by simp
moreover
have "x' = fst (castAbs xs s (Abs xs x X))" and
"X' = snd (castAbs xs s (Abs xs x X))" using * by auto
ultimately
have "wls s X'" and "Abs xs x X = Abs xs x' X'" by auto
thus ?thesis using Y X by(auto simp add: wls_Abs_subst_all)
qed
lemma castAbs_Abs_vsubst:
assumes "isInBar (xs,s)" and "wls s X"
and "castAbs xs s (Abs xs x X) = (x',X')"
shows "(X #[y // x]_xs) = (X' #[y // x']_xs)"
using assms unfolding vsubst_def
by (intro castAbs_Abs_subst) auto
lemma castAbs_inj[simp]:
assumes *: "wlsAbs (xs,s) A" and **: "wlsAbs (xs,s) A'"
shows "(castAbs xs s A = castAbs xs s A') = (A = A')"
using assms Abs_castAbs by fastforce
lemmas castAbs_simps =
wls_castAbs Abs_castAbs castAbs_inj
lemma absCase_Abs_swap[simp]:
assumes isInBar: "isInBar (xs,s)" and X: "wls s X"
and f_compat: "compatAbsSwap xs s f"
shows "absCase xs s f (Abs xs x X) = f x X"
proof-
obtain x' X' where 1: "castAbs xs s (Abs xs x X) = (x',X')"
by (cases "castAbs xs s (Abs xs x X)", auto)
hence 2: "absCase xs s f (Abs xs x X) = f x' X'"
unfolding absCase_def using isInBar X by auto
have "⋀ y. (y = x ∨ fresh xs y X) ∧ (y = x' ∨ fresh xs y X')
⟹ (X #[y ∧ x]_xs) = (X' #[y ∧ x']_xs)"
using isInBar X 1 by(simp add: castAbs_Abs_swap)
hence "f x X = f x' X'" using f_compat
unfolding compatAbsSwap_def by fastforce
thus ?thesis using 2 by simp
qed
lemma absCase_Abs_subst[simp]:
assumes isInBar: "isInBar (xs,s)" and X: "wls s X"
and f_compat: "compatAbsSubst xs s f"
shows "absCase xs s f (Abs xs x X) = f x X"
proof-
obtain x' X' where 1: "castAbs xs s (Abs xs x X) = (x',X')"
by (cases "castAbs xs s (Abs xs x X)") auto
hence 2: "absCase xs s f (Abs xs x X) = f x' X'"
unfolding absCase_def using isInBar X by auto
have "⋀ Y. wls (asSort xs) Y ⟹ (X #[Y / x]_xs) = (X' #[Y / x']_xs)"
using isInBar X 1 by(simp add: castAbs_Abs_subst)
hence "f x X = f x' X'" using f_compat unfolding compatAbsSubst_def by blast
thus ?thesis using 2 by simp
qed
lemma compatAbsVsubst_imp_compatAbsSubst[simp]:
"compatAbsVsubst xs s f ⟹ compatAbsSubst xs s f"
unfolding compatAbsSubst_def compatAbsVsubst_def
vsubst_def by auto
lemma absCase_Abs_vsubst[simp]:
assumes "isInBar (xs,s)" and "wls s X"
and "compatAbsVsubst xs s f"
shows "absCase xs s f (Abs xs x X) = f x X"
using assms by(simp add: absCase_Abs_subst)
lemma absCase_cong[fundef_cong]:
assumes "compatAbsSwap xs s f ∨ compatAbsSubst xs s f ∨ compatAbsVsubst xs s f"
and "compatAbsSwap xs s f' ∨ compatAbsSubst xs s f' ∨ compatAbsVsubst xs s f'"
and "⋀ x X. wls s X ⟹ f x X = f' x X"
shows "wlsAbs (xs,s) A ⟹
absCase xs s f A = absCase xs s f' A"
apply(erule wlsAbs_cases) using assms by auto
lemmas absCase_simps = absCase_Abs_swap absCase_Abs_subst
compatAbsVsubst_imp_compatAbsSubst absCase_Abs_vsubst
lemmas abs_cast_simps = castAbs_simps absCase_simps
lemmas cast_simps = term_cast_simps abs_cast_simps
lemmas wls_item_simps =
wlsAll_imp_goodAll paramS_simps Cons_wls_simps all_preserve_wls
wls_freeCons wls_allOpers_simps wls_allOpers_otherSimps Abs_inj_fresh cast_simps
lemmas wls_copy_of_good_item_simps = good_freeCons good_allOpers_simps good_allOpers_otherSimps
param_simps all_preserve_good
declare wls_copy_of_good_item_simps [simp del]
declare qItem_simps [simp del] declare qItem_versus_item_simps [simp del]
end
end
Theory Iteration
section ‹Iteration›
theory Iteration imports Well_Sorted_Terms
begin
text‹In this section, we introduce first-order models (models, for short).
These are structures having operators that
match those for terms (including variable-injection, binding operations, freshness,
swapping and substitution) and satisfy some clauses,
and show that terms form initial models. This gives iteration principles.
As a matter of notation: the prefix
``g" will stand for ``generalized" -- elements of models are referred to as ``generalized terms".
The actual full prefix will be ``ig" (where ``i" stands for ``iteration"), symbolizing the fact that
the models from this section support iteration, and not general recursion.
The latter is dealt with by the models introduced in the next section, for which we
use the simple prefix ``g".
›
subsection ‹Models›
text‹We have two basic kinds of models:
\\- fresh-swap (FSw) models, featuring operations corresponding to
the concrete syntactic constructs (``Var", ``Op", ``Abs"),
henceforth referred to simply as {\em the constructs}, and to fresh and swap;
\\- fresh-swap-subst (FSb) models, featuring substitution instead of swapping.
We also consider two combinations of the above, FSwSb-models and FSbSw-models.
To keep things structurally
simple, we use one single Isabelle for all the 4 kinds models,
allowing the most generous signature.
Since terms are the main actors of our theory, models being considered only
for the sake of recursive definitions, we call the items inhabiting these models
``generalized" terms, abstractions and inputs, and correspondingly
the operations; hence the prefix ``g" from the names of the type parameters and
operators.
(However,
we refer to the generalized items using the same notations as for
``concrete items": X, A, etc.)
%
Indeed, a model can be regarded as implementing
a generalization/axiomatization of the term structure, where now the objects are
not terms, but do have term-like properties.
›
subsubsection ‹Raw models›
record ('index,'bindex,'varSort,'sort,'opSym,'var,'gTerm,'gAbs)model =
igWls :: "'sort ⇒ 'gTerm ⇒ bool"
igWlsAbs :: "'varSort × 'sort ⇒ 'gAbs ⇒ bool"
igVar :: "'varSort ⇒ 'var ⇒ 'gTerm"
igAbs :: "'varSort ⇒ 'var ⇒ 'gTerm ⇒ 'gAbs"
igOp :: "'opSym ⇒ ('index,'gTerm)input ⇒ ('bindex,'gAbs)input ⇒ 'gTerm"
igFresh :: "'varSort ⇒ 'var ⇒ 'gTerm ⇒ bool"
igFreshAbs :: "'varSort ⇒ 'var ⇒ 'gAbs ⇒ bool"
igSwap :: "'varSort ⇒ 'var ⇒ 'var ⇒ 'gTerm ⇒ 'gTerm"
igSwapAbs :: "'varSort ⇒ 'var ⇒ 'var ⇒ 'gAbs ⇒ 'gAbs"
igSubst :: "'varSort ⇒ 'gTerm ⇒ 'var ⇒ 'gTerm ⇒ 'gTerm"
igSubstAbs :: "'varSort ⇒ 'gTerm ⇒ 'var ⇒ 'gAbs ⇒ 'gAbs"
text‹\
\\- ``igSwap MOD zs z1 z2 X" swaps in X z1 and z2 (assumed of sorts zs).
\\- ``igSubst MOD ys Y x X" substitutes, in X, Y with y (assumed of sort ys).›
definition igFreshInp where
"igFreshInp MOD ys y inp == liftAll (igFresh MOD ys y) inp"
definition igFreshBinp where
"igFreshBinp MOD ys y binp == liftAll (igFreshAbs MOD ys y) binp"
definition igSwapInp where
"igSwapInp MOD zs z1 z2 inp == lift (igSwap MOD zs z1 z2) inp"
definition igSwapBinp where
"igSwapBinp MOD zs z1 z2 binp == lift (igSwapAbs MOD zs z1 z2) binp"
definition igSubstInp where
"igSubstInp MOD ys Y y inp == lift (igSubst MOD ys Y y) inp"
definition igSubstBinp where
"igSubstBinp MOD ys Y y binp == lift (igSubstAbs MOD ys Y y) binp"
context FixSyn
begin
subsubsection ‹Well-sorted models of various kinds›
text‹We define the following kinds of well-sorted models
\\- fresh-swap models (predicate ``iwlsFSw");
\\- fresh-subst models (``iwlsFSb");
\\- fresh-swap-subst models (``iwlsFSwSb");
\\- fresh-subst-swap models (``iwlsFSbSw").
All of these models are defined as raw models subject to various Horn conditions:
\\- For ``iwlsFSw":
\\--- definition-like clauses for ``fresh" and ``swap" in terms of the
construct operators;
\\--- congruence for abstraction based on fresh and swap (mirroring the abstraction case in
the definition of alpha-equivalence for quasi-terms).
%
\footnote{Here, by ``congruence for abstraction" we do not mean the standard notion of congrunece
(satisfied by any operator once or ever), but a {\em stronger} notion: in order for two abstractions
to be equal, it is not required that their ariguments be equal, but that they be in a
``permutative" relationship based either on swapping or on substitution.}
%
\\- For ``iwlsFSb": the same as for ``iwlsFSw", except that:
\\--- ``swap" is replaced by ``subst";
%
\footnote{
Note that traditionally alpha-equivalence is defined using ``subst", not ``swap".
}
%
\\--- The [fresh and swap]-based congrunce clause is replaced by an ``abstraction-renaming" clause,
which is stronger than the corresponding [fresh and subst]-based congruence clause.
%
\footnote{
We also define the [fresh and subst]-based congruence clause, although we do not
employ it directly in the definition of any kind of model.
}
%
\\- For ``iwlsFSwSb": the clauses for ``iwlsFSw", plus some of the definition-like clauses for ``subst".
%
\footnote{Not all the ``subst" definition-like clauses from ``iwlsFSb" are required
for ``iwlsFSwSb" -- namely, the clause that
we call ``igSubstIGAbsCls2" is not required here.
}
%
\\- For ``iwlsFSbSw": the clauses for ``iwlsFSb", plus definition-like clauses for ``swap".
Thus, a fresh-swap-subst model is also a fresh-swap model, and
a fresh-subst-swap model is also a fresh-subst model.
For convenience, all these 4 kinds of models are defined on one single type, that of {\em raw models},
which interpret the most generous signature, comprizing all the operations and relations required by all
4 kinds of models.
Note that, although some operations (namely, ``subst" or ``swap") may not be involved in the clauses for certain kinds
of models, the extra structure is harmless to the development of their theory.
Note that for the models operations and relations we do not actually write ``fresh", ``swap" and ``subst", but
``igFresh", ``igSwap" and ``igSubst".
As usual, we shall have not only term versions, but also abstraction versions of the above
operations.
›
definition igWlsInp where
"igWlsInp MOD delta inp ==
wlsOpS delta ∧ sameDom (arOf delta) inp ∧ liftAll2 (igWls MOD) (arOf delta) inp"
lemmas igWlsInp_defs = igWlsInp_def sameDom_def liftAll2_def
definition igWlsBinp where
"igWlsBinp MOD delta binp ==
wlsOpS delta ∧ sameDom (barOf delta) binp ∧ liftAll2 (igWlsAbs MOD) (barOf delta) binp"
lemmas igWlsBinp_defs = igWlsBinp_def sameDom_def liftAll2_def
text‹Domain disjointness:›
definition igWlsDisj where
"igWlsDisj MOD == ∀ s s' X. igWls MOD s X ∧ igWls MOD s' X ⟶ s = s'"
definition igWlsAbsDisj where
"igWlsAbsDisj MOD ==
∀ xs s xs' s' A.
isInBar (xs,s) ∧ isInBar (xs',s') ∧
igWlsAbs MOD (xs,s) A ∧ igWlsAbs MOD (xs',s') A
⟶ xs = xs' ∧ s = s'"
definition igWlsAllDisj where
"igWlsAllDisj MOD ==
igWlsDisj MOD ∧ igWlsAbsDisj MOD"
lemmas igWlsAllDisj_defs =
igWlsAllDisj_def
igWlsDisj_def igWlsAbsDisj_def
text ‹Abstration domains inhabited only within bound arities:›
definition igWlsAbsIsInBar where
"igWlsAbsIsInBar MOD ==
∀ us s A. igWlsAbs MOD (us,s) A ⟶ isInBar (us,s)"
text‹Domain preservation by the operators: weak (``if") versions and strong (``iff") versions
(for the latter, we use the suffix ``STR"):›
text‹The constructs preserve the domains:›
definition igVarIPresIGWls where
"igVarIPresIGWls MOD ==
∀ xs x. igWls MOD (asSort xs) (igVar MOD xs x)"
definition igAbsIPresIGWls where
"igAbsIPresIGWls MOD ==
∀ xs s x X. isInBar (xs,s) ∧ igWls MOD s X ⟶
igWlsAbs MOD (xs,s) (igAbs MOD xs x X)"
definition igAbsIPresIGWlsSTR where
"igAbsIPresIGWlsSTR MOD ==
∀ xs s x X. isInBar (xs,s) ⟶
igWlsAbs MOD (xs,s) (igAbs MOD xs x X) =
igWls MOD s X"
lemma igAbsIPresIGWlsSTR_imp_igAbsIPresIGWls:
"igAbsIPresIGWlsSTR MOD ⟹ igAbsIPresIGWls MOD"
unfolding igAbsIPresIGWlsSTR_def igAbsIPresIGWls_def by simp
definition igOpIPresIGWls where
"igOpIPresIGWls MOD ==
∀ delta inp binp.
igWlsInp MOD delta inp ∧ igWlsBinp MOD delta binp
⟶ igWls MOD (stOf delta) (igOp MOD delta inp binp)"
definition igOpIPresIGWlsSTR where
"igOpIPresIGWlsSTR MOD ==
∀ delta inp binp.
igWls MOD (stOf delta) (igOp MOD delta inp binp) =
(igWlsInp MOD delta inp ∧ igWlsBinp MOD delta binp)"
lemma igOpIPresIGWlsSTR_imp_igOpIPresIGWls:
"igOpIPresIGWlsSTR MOD ⟹ igOpIPresIGWls MOD"
unfolding igOpIPresIGWlsSTR_def igOpIPresIGWls_def by simp
definition igConsIPresIGWls where
"igConsIPresIGWls MOD ==
igVarIPresIGWls MOD ∧
igAbsIPresIGWls MOD ∧
igOpIPresIGWls MOD"
lemmas igConsIPresIGWls_defs = igConsIPresIGWls_def
igVarIPresIGWls_def
igAbsIPresIGWls_def
igOpIPresIGWls_def
definition igConsIPresIGWlsSTR where
"igConsIPresIGWlsSTR MOD ==
igVarIPresIGWls MOD ∧
igAbsIPresIGWlsSTR MOD ∧
igOpIPresIGWlsSTR MOD"
lemmas igConsIPresIGWlsSTR_defs = igConsIPresIGWlsSTR_def
igVarIPresIGWls_def
igAbsIPresIGWlsSTR_def
igOpIPresIGWlsSTR_def
lemma igConsIPresIGWlsSTR_imp_igConsIPresIGWls:
"igConsIPresIGWlsSTR MOD ⟹ igConsIPresIGWls MOD"
unfolding igConsIPresIGWlsSTR_def igConsIPresIGWls_def
using
igAbsIPresIGWlsSTR_imp_igAbsIPresIGWls
igOpIPresIGWlsSTR_imp_igOpIPresIGWls
by auto
text‹``swap" preserves the domains:›
definition igSwapIPresIGWls where
"igSwapIPresIGWls MOD ==
∀ zs z1 z2 s X. igWls MOD s X ⟶
igWls MOD s (igSwap MOD zs z1 z2 X)"
definition igSwapIPresIGWlsSTR where
"igSwapIPresIGWlsSTR MOD ==
∀ zs z1 z2 s X. igWls MOD s (igSwap MOD zs z1 z2 X) =
igWls MOD s X"
lemma igSwapIPresIGWlsSTR_imp_igSwapIPresIGWls:
"igSwapIPresIGWlsSTR MOD ⟹ igSwapIPresIGWls MOD"
unfolding igSwapIPresIGWlsSTR_def igSwapIPresIGWls_def by simp
definition igSwapAbsIPresIGWlsAbs where
"igSwapAbsIPresIGWlsAbs MOD ==
∀ zs z1 z2 us s A.
isInBar (us,s) ∧ igWlsAbs MOD (us,s) A ⟶
igWlsAbs MOD (us,s) (igSwapAbs MOD zs z1 z2 A)"
definition igSwapAbsIPresIGWlsAbsSTR where
"igSwapAbsIPresIGWlsAbsSTR MOD ==
∀ zs z1 z2 us s A.
igWlsAbs MOD (us,s) (igSwapAbs MOD zs z1 z2 A) =
igWlsAbs MOD (us,s) A"
lemma igSwapAbsIPresIGWlsAbsSTR_imp_igSwapAbsIPresIGWlsAbs:
"igSwapAbsIPresIGWlsAbsSTR MOD ⟹ igSwapAbsIPresIGWlsAbs MOD"
unfolding igSwapAbsIPresIGWlsAbsSTR_def igSwapAbsIPresIGWlsAbs_def by simp
definition igSwapAllIPresIGWlsAll where
"igSwapAllIPresIGWlsAll MOD ==
igSwapIPresIGWls MOD ∧ igSwapAbsIPresIGWlsAbs MOD"
lemmas igSwapAllIPresIGWlsAll_defs = igSwapAllIPresIGWlsAll_def
igSwapIPresIGWls_def igSwapAbsIPresIGWlsAbs_def
definition igSwapAllIPresIGWlsAllSTR where
"igSwapAllIPresIGWlsAllSTR MOD ==
igSwapIPresIGWlsSTR MOD ∧ igSwapAbsIPresIGWlsAbsSTR MOD"
lemmas igSwapAllIPresIGWlsAllSTR_defs = igSwapAllIPresIGWlsAllSTR_def
igSwapIPresIGWlsSTR_def igSwapAbsIPresIGWlsAbsSTR_def
lemma igSwapAllIPresIGWlsAllSTR_imp_igSwapAllIPresIGWlsAll:
"igSwapAllIPresIGWlsAllSTR MOD ⟹ igSwapAllIPresIGWlsAll MOD"
unfolding igSwapAllIPresIGWlsAllSTR_def igSwapAllIPresIGWlsAll_def
using
igSwapIPresIGWlsSTR_imp_igSwapIPresIGWls
igSwapAbsIPresIGWlsAbsSTR_imp_igSwapAbsIPresIGWlsAbs
by auto
text‹``subst" preserves the domains:›
definition igSubstIPresIGWls where
"igSubstIPresIGWls MOD ==
∀ ys Y y s X. igWls MOD (asSort ys) Y ∧ igWls MOD s X ⟶
igWls MOD s (igSubst MOD ys Y y X)"
definition igSubstIPresIGWlsSTR where
"igSubstIPresIGWlsSTR MOD ==
∀ ys Y y s X.
igWls MOD s (igSubst MOD ys Y y X) =
(igWls MOD (asSort ys) Y ∧ igWls MOD s X)"
lemma igSubstIPresIGWlsSTR_imp_igSubstIPresIGWls:
"igSubstIPresIGWlsSTR MOD ⟹ igSubstIPresIGWls MOD"
unfolding igSubstIPresIGWlsSTR_def igSubstIPresIGWls_def by simp
definition igSubstAbsIPresIGWlsAbs where
"igSubstAbsIPresIGWlsAbs MOD ==
∀ ys Y y us s A.
isInBar (us,s) ∧ igWls MOD (asSort ys) Y ∧ igWlsAbs MOD (us,s) A ⟶
igWlsAbs MOD (us,s) (igSubstAbs MOD ys Y y A)"
definition igSubstAbsIPresIGWlsAbsSTR where
"igSubstAbsIPresIGWlsAbsSTR MOD ==
∀ ys Y y us s A.
igWlsAbs MOD (us,s) (igSubstAbs MOD ys Y y A) =
(igWls MOD (asSort ys) Y ∧ igWlsAbs MOD (us,s) A)"
lemma igSubstAbsIPresIGWlsAbsSTR_imp_igSubstAbsIPresIGWlsAbs:
"igSubstAbsIPresIGWlsAbsSTR MOD ⟹ igSubstAbsIPresIGWlsAbs MOD"
unfolding igSubstAbsIPresIGWlsAbsSTR_def igSubstAbsIPresIGWlsAbs_def by simp
definition igSubstAllIPresIGWlsAll where
"igSubstAllIPresIGWlsAll MOD ==
igSubstIPresIGWls MOD ∧ igSubstAbsIPresIGWlsAbs MOD"
lemmas igSubstAllIPresIGWlsAll_defs = igSubstAllIPresIGWlsAll_def
igSubstIPresIGWls_def igSubstAbsIPresIGWlsAbs_def
definition igSubstAllIPresIGWlsAllSTR where
"igSubstAllIPresIGWlsAllSTR MOD ==
igSubstIPresIGWlsSTR MOD ∧ igSubstAbsIPresIGWlsAbsSTR MOD"
lemmas igSubstAllIPresIGWlsAllSTR_defs = igSubstAllIPresIGWlsAllSTR_def
igSubstIPresIGWlsSTR_def igSubstAbsIPresIGWlsAbsSTR_def
lemma igSubstAllIPresIGWlsAllSTR_imp_igSubstAllIPresIGWlsAll:
"igSubstAllIPresIGWlsAllSTR MOD ⟹ igSubstAllIPresIGWlsAll MOD"
unfolding igSubstAllIPresIGWlsAllSTR_def igSubstAllIPresIGWlsAll_def
using
igSubstIPresIGWlsSTR_imp_igSubstIPresIGWls
igSubstAbsIPresIGWlsAbsSTR_imp_igSubstAbsIPresIGWlsAbs
by auto
text‹Clauses for fresh: fully conditional versions and less conditional,
stronger versions (the latter having suffix ``STR").›
definition igFreshIGVar where
"igFreshIGVar MOD ==
∀ ys y xs x.
ys ≠ xs ∨ y ≠ x ⟶
igFresh MOD ys y (igVar MOD xs x)"
definition igFreshIGAbs1 where
"igFreshIGAbs1 MOD ==
∀ ys y s X.
isInBar (ys,s) ∧ igWls MOD s X ⟶
igFreshAbs MOD ys y (igAbs MOD ys y X)"
definition igFreshIGAbs1STR where
"igFreshIGAbs1STR MOD ==
∀ ys y X. igFreshAbs MOD ys y (igAbs MOD ys y X)"
lemma igFreshIGAbs1STR_imp_igFreshIGAbs1:
"igFreshIGAbs1STR MOD ⟹ igFreshIGAbs1 MOD"
unfolding igFreshIGAbs1STR_def igFreshIGAbs1_def by simp
definition igFreshIGAbs2 where
"igFreshIGAbs2 MOD ==
∀ ys y xs x s X.
isInBar (xs,s) ∧ igWls MOD s X ⟶
igFresh MOD ys y X ⟶ igFreshAbs MOD ys y (igAbs MOD xs x X)"
definition igFreshIGAbs2STR where
"igFreshIGAbs2STR MOD ==
∀ ys y xs x X.
igFresh MOD ys y X ⟶ igFreshAbs MOD ys y (igAbs MOD xs x X)"
lemma igFreshIGAbs2STR_imp_igFreshIGAbs2:
"igFreshIGAbs2STR MOD ⟹ igFreshIGAbs2 MOD"
unfolding igFreshIGAbs2STR_def igFreshIGAbs2_def by simp
definition igFreshIGOp where
"igFreshIGOp MOD ==
∀ ys y delta inp binp.
igWlsInp MOD delta inp ∧ igWlsBinp MOD delta binp ⟶
(igFreshInp MOD ys y inp ∧ igFreshBinp MOD ys y binp) ⟶
igFresh MOD ys y (igOp MOD delta inp binp)"
definition igFreshIGOpSTR where
"igFreshIGOpSTR MOD ==
∀ ys y delta inp binp.
igFreshInp MOD ys y inp ∧ igFreshBinp MOD ys y binp ⟶
igFresh MOD ys y (igOp MOD delta inp binp)"
lemma igFreshIGOpSTR_imp_igFreshIGOp:
"igFreshIGOpSTR MOD ⟹ igFreshIGOp MOD"
unfolding igFreshIGOpSTR_def igFreshIGOp_def by simp
definition igFreshCls where
"igFreshCls MOD ==
igFreshIGVar MOD ∧
igFreshIGAbs1 MOD ∧ igFreshIGAbs2 MOD ∧
igFreshIGOp MOD"
lemmas igFreshCls_defs = igFreshCls_def
igFreshIGVar_def
igFreshIGAbs1_def igFreshIGAbs2_def
igFreshIGOp_def
definition igFreshClsSTR where
"igFreshClsSTR MOD ==
igFreshIGVar MOD ∧
igFreshIGAbs1STR MOD ∧ igFreshIGAbs2STR MOD ∧
igFreshIGOpSTR MOD"
lemmas igFreshClsSTR_defs = igFreshClsSTR_def
igFreshIGVar_def
igFreshIGAbs1STR_def igFreshIGAbs2STR_def
igFreshIGOpSTR_def
lemma igFreshClsSTR_imp_igFreshCls:
"igFreshClsSTR MOD ⟹ igFreshCls MOD"
unfolding igFreshClsSTR_def igFreshCls_def
using
igFreshIGAbs1STR_imp_igFreshIGAbs1 igFreshIGAbs2STR_imp_igFreshIGAbs2
igFreshIGOpSTR_imp_igFreshIGOp
by auto
definition igSwapIGVar where
"igSwapIGVar MOD ==
∀ zs z1 z2 xs x.
igSwap MOD zs z1 z2 (igVar MOD xs x) = igVar MOD xs (x @xs[z1 ∧ z2]_zs)"
definition igSwapIGAbs where
"igSwapIGAbs MOD ==
∀ zs z1 z2 xs x s X.
isInBar (xs,s) ∧ igWls MOD s X ⟶
igSwapAbs MOD zs z1 z2 (igAbs MOD xs x X) =
igAbs MOD xs (x @xs[z1 ∧ z2]_zs) (igSwap MOD zs z1 z2 X)"
definition igSwapIGAbsSTR where
"igSwapIGAbsSTR MOD ==
∀ zs z1 z2 xs x X.
igSwapAbs MOD zs z1 z2 (igAbs MOD xs x X) =
igAbs MOD xs (x @xs[z1 ∧ z2]_zs) (igSwap MOD zs z1 z2 X)"
lemma igSwapIGAbsSTR_imp_igSwapIGAbs:
"igSwapIGAbsSTR MOD ⟹ igSwapIGAbs MOD"
unfolding igSwapIGAbsSTR_def igSwapIGAbs_def by simp
definition igSwapIGOp where
"igSwapIGOp MOD ==
∀ zs z1 z2 delta inp binp.
igWlsInp MOD delta inp ∧ igWlsBinp MOD delta binp ⟶
igSwap MOD zs z1 z2 (igOp MOD delta inp binp) =
igOp MOD delta (igSwapInp MOD zs z1 z2 inp) (igSwapBinp MOD zs z1 z2 binp)"
definition igSwapIGOpSTR where
"igSwapIGOpSTR MOD ==
∀ zs z1 z2 delta inp binp.
igSwap MOD zs z1 z2 (igOp MOD delta inp binp) =
igOp MOD delta (igSwapInp MOD zs z1 z2 inp) (igSwapBinp MOD zs z1 z2 binp)"
lemma igSwapIGOpSTR_imp_igSwapIGOp:
"igSwapIGOpSTR MOD ⟹ igSwapIGOp MOD"
unfolding igSwapIGOpSTR_def igSwapIGOp_def by simp
definition igSwapCls where
"igSwapCls MOD ==
igSwapIGVar MOD ∧
igSwapIGAbs MOD ∧
igSwapIGOp MOD"
lemmas igSwapCls_defs = igSwapCls_def
igSwapIGVar_def
igSwapIGAbs_def
igSwapIGOp_def
definition igSwapClsSTR where
"igSwapClsSTR MOD ==
igSwapIGVar MOD ∧
igSwapIGAbsSTR MOD ∧
igSwapIGOpSTR MOD"
lemmas igSwapClsSTR_defs = igSwapClsSTR_def
igSwapIGVar_def
igSwapIGAbsSTR_def
igSwapIGOpSTR_def
lemma igSwapClsSTR_imp_igSwapCls:
"igSwapClsSTR MOD ⟹ igSwapCls MOD"
unfolding igSwapClsSTR_def igSwapCls_def
using
igSwapIGAbsSTR_imp_igSwapIGAbs
igSwapIGOpSTR_imp_igSwapIGOp
by auto
definition igSubstIGVar1 where
"igSubstIGVar1 MOD ==
∀ ys y Y xs x.
igWls MOD (asSort ys) Y ⟶
(ys ≠ xs ∨ y ≠ x) ⟶
igSubst MOD ys Y y (igVar MOD xs x) = igVar MOD xs x"
definition igSubstIGVar1STR where
"igSubstIGVar1STR MOD ==
(∀ ys y y1 xs x.
(ys ≠ xs ∨ x ≠ y) ⟶
igSubst MOD ys (igVar MOD ys y1) y (igVar MOD xs x) = igVar MOD xs x)
∧
(∀ ys y Y xs x.
igWls MOD (asSort ys) Y ⟶
(ys ≠ xs ∨ y ≠ x) ⟶
igSubst MOD ys Y y (igVar MOD xs x) = igVar MOD xs x)"
lemma igSubstIGVar1STR_imp_igSubstIGVar1:
"igSubstIGVar1STR MOD ⟹ igSubstIGVar1 MOD"
unfolding igSubstIGVar1STR_def igSubstIGVar1_def by simp
definition igSubstIGVar2 where
"igSubstIGVar2 MOD ==
∀ ys y Y.
igWls MOD (asSort ys) Y ⟶
igSubst MOD ys Y y (igVar MOD ys y) = Y"
definition igSubstIGVar2STR where
"igSubstIGVar2STR MOD ==
(∀ ys y y1.
igSubst MOD ys (igVar MOD ys y1) y (igVar MOD ys y) = igVar MOD ys y1)
∧
(∀ ys y Y.
igWls MOD (asSort ys) Y ⟶
igSubst MOD ys Y y (igVar MOD ys y) = Y)"
lemma igSubstIGVar2STR_imp_igSubstIGVar2:
"igSubstIGVar2STR MOD ⟹ igSubstIGVar2 MOD"
unfolding igSubstIGVar2STR_def igSubstIGVar2_def by simp
definition igSubstIGAbs where
"igSubstIGAbs MOD ==
∀ ys y Y xs x s X.
isInBar (xs,s) ∧ igWls MOD (asSort ys) Y ∧ igWls MOD s X ⟶
(xs ≠ ys ∨ x ≠ y) ∧ igFresh MOD xs x Y ⟶
igSubstAbs MOD ys Y y (igAbs MOD xs x X) =
igAbs MOD xs x (igSubst MOD ys Y y X)"
definition igSubstIGAbsSTR where
"igSubstIGAbsSTR MOD ==
∀ ys y Y xs x X.
(xs ≠ ys ∨ x ≠ y) ∧ igFresh MOD xs x Y ⟶
igSubstAbs MOD ys Y y (igAbs MOD xs x X) =
igAbs MOD xs x (igSubst MOD ys Y y X)"
lemma igSubstIGAbsSTR_imp_igSubstIGAbs:
"igSubstIGAbsSTR MOD ⟹ igSubstIGAbs MOD"
unfolding igSubstIGAbsSTR_def igSubstIGAbs_def by simp
definition igSubstIGOp where
"igSubstIGOp MOD ==
∀ ys y Y delta inp binp.
igWls MOD (asSort ys) Y ∧
igWlsInp MOD delta inp ∧ igWlsBinp MOD delta binp ⟶
igSubst MOD ys Y y (igOp MOD delta inp binp) =
igOp MOD delta (igSubstInp MOD ys Y y inp) (igSubstBinp MOD ys Y y binp)"
definition igSubstIGOpSTR where
"igSubstIGOpSTR MOD ==
(∀ ys y y1 delta inp binp.
igSubst MOD ys (igVar MOD ys y1) y (igOp MOD delta inp binp) =
igOp MOD delta (igSubstInp MOD ys (igVar MOD ys y1) y inp)
(igSubstBinp MOD ys (igVar MOD ys y1) y binp))
∧
(∀ ys y Y delta inp binp.
igWls MOD (asSort ys) Y ⟶
igSubst MOD ys Y y (igOp MOD delta inp binp) =
igOp MOD delta (igSubstInp MOD ys Y y inp) (igSubstBinp MOD ys Y y binp))"
lemma igSubstIGOpSTR_imp_igSubstIGOp:
"igSubstIGOpSTR MOD ⟹ igSubstIGOp MOD"
unfolding igSubstIGOpSTR_def igSubstIGOp_def by simp
definition igSubstCls where
"igSubstCls MOD ==
igSubstIGVar1 MOD ∧ igSubstIGVar2 MOD ∧
igSubstIGAbs MOD ∧
igSubstIGOp MOD"
lemmas igSubstCls_defs = igSubstCls_def
igSubstIGVar1_def igSubstIGVar2_def
igSubstIGAbs_def
igSubstIGOp_def
definition igSubstClsSTR where
"igSubstClsSTR MOD ==
igSubstIGVar1STR MOD ∧ igSubstIGVar2STR MOD ∧
igSubstIGAbsSTR MOD ∧
igSubstIGOpSTR MOD"
lemmas igSubstClsSTR_defs = igSubstClsSTR_def
igSubstIGVar1STR_def igSubstIGVar2STR_def
igSubstIGAbsSTR_def
igSubstIGOpSTR_def
lemma igSubstClsSTR_imp_igSubstCls:
"igSubstClsSTR MOD ⟹ igSubstCls MOD"
unfolding igSubstClsSTR_def igSubstCls_def
using
igSubstIGVar1STR_imp_igSubstIGVar1
igSubstIGVar2STR_imp_igSubstIGVar2
igSubstIGAbsSTR_imp_igSubstIGAbs
igSubstIGOpSTR_imp_igSubstIGOp
by auto
definition igAbsCongS where
"igAbsCongS MOD ==
∀ xs x x' y s X X'.
isInBar (xs,s) ∧ igWls MOD s X ∧ igWls MOD s X' ⟶
igFresh MOD xs y X ∧ igFresh MOD xs y X' ∧ igSwap MOD xs y x X = igSwap MOD xs y x' X' ⟶
igAbs MOD xs x X = igAbs MOD xs x' X'"
definition igAbsCongSSTR where
"igAbsCongSSTR MOD ==
∀ xs x x' y X X'.
igFresh MOD xs y X ∧ igFresh MOD xs y X' ∧ igSwap MOD xs y x X = igSwap MOD xs y x' X' ⟶
igAbs MOD xs x X = igAbs MOD xs x' X'"
lemma igAbsCongSSTR_imp_igAbsCongS:
"igAbsCongSSTR MOD ⟹ igAbsCongS MOD"
unfolding igAbsCongSSTR_def igAbsCongS_def by auto
definition igAbsCongU where
"igAbsCongU MOD ==
∀ xs x x' y s X X'.
isInBar (xs,s) ∧ igWls MOD s X ∧ igWls MOD s X' ⟶
igFresh MOD xs y X ∧ igFresh MOD xs y X' ∧
igSubst MOD xs (igVar MOD xs y) x X = igSubst MOD xs (igVar MOD xs y) x' X' ⟶
igAbs MOD xs x X = igAbs MOD xs x' X'"
definition igAbsCongUSTR where
"igAbsCongUSTR MOD ==
∀ xs x x' y X X'.
igFresh MOD xs y X ∧ igFresh MOD xs y X' ∧
igSubst MOD xs (igVar MOD xs y) x X = igSubst MOD xs (igVar MOD xs y) x' X' ⟶
igAbs MOD xs x X = igAbs MOD xs x' X'"
lemma igAbsCongUSTR_imp_igAbsCongU:
"igAbsCongUSTR MOD ⟹ igAbsCongU MOD"
unfolding igAbsCongUSTR_def igAbsCongU_def by auto
definition igAbsRen where
"igAbsRen MOD ==
∀ xs y x s X.
isInBar (xs,s) ∧ igWls MOD s X ⟶
igFresh MOD xs y X ⟶
igAbs MOD xs y (igSubst MOD xs (igVar MOD xs y) x X) = igAbs MOD xs x X"
definition igAbsRenSTR where
"igAbsRenSTR MOD ==
∀ xs y x X.
igFresh MOD xs y X ⟶
igAbs MOD xs y (igSubst MOD xs (igVar MOD xs y) x X) = igAbs MOD xs x X"
lemma igAbsRenSTR_imp_igAbsRen:
"igAbsRenSTR MOD ⟹ igAbsRen MOD"
unfolding igAbsRenSTR_def igAbsRen_def by simp
lemma igAbsRenSTR_imp_igAbsCongUSTR:
"igAbsRenSTR MOD ⟹ igAbsCongUSTR MOD"
unfolding igAbsCongUSTR_def igAbsRenSTR_def by metis
text ‹Well-sorted fresh-swap models:›
definition iwlsFSw where
"iwlsFSw MOD ==
igWlsAllDisj MOD ∧ igWlsAbsIsInBar MOD ∧
igConsIPresIGWls MOD ∧ igSwapAllIPresIGWlsAll MOD ∧
igFreshCls MOD ∧ igSwapCls MOD ∧ igAbsCongS MOD"
lemmas iwlsFSw_defs1 = iwlsFSw_def
igWlsAllDisj_def igWlsAbsIsInBar_def
igConsIPresIGWls_def igSwapAllIPresIGWlsAll_def
igFreshCls_def igSwapCls_def igAbsCongS_def
lemmas iwlsFSw_defs = iwlsFSw_def
igWlsAllDisj_defs igWlsAbsIsInBar_def
igConsIPresIGWls_defs igSwapAllIPresIGWlsAll_defs
igFreshCls_defs igSwapCls_defs igAbsCongS_def
definition iwlsFSwSTR where
"iwlsFSwSTR MOD ==
igWlsAllDisj MOD ∧ igWlsAbsIsInBar MOD ∧
igConsIPresIGWlsSTR MOD ∧ igSwapAllIPresIGWlsAllSTR MOD ∧
igFreshClsSTR MOD ∧ igSwapClsSTR MOD ∧ igAbsCongSSTR MOD"
lemmas iwlsFSwSTR_defs1 = iwlsFSwSTR_def
igWlsAllDisj_def igWlsAbsIsInBar_def
igConsIPresIGWlsSTR_def igSwapAllIPresIGWlsAllSTR_def
igFreshClsSTR_def igSwapClsSTR_def igAbsCongSSTR_def
lemmas iwlsFSwSTR_defs = iwlsFSwSTR_def
igWlsAllDisj_defs igWlsAbsIsInBar_def
igConsIPresIGWlsSTR_defs igSwapAllIPresIGWlsAllSTR_defs
igFreshClsSTR_defs igSwapClsSTR_defs igAbsCongSSTR_def
lemma iwlsFSwSTR_imp_iwlsFSw:
"iwlsFSwSTR MOD ⟹ iwlsFSw MOD"
unfolding iwlsFSwSTR_def iwlsFSw_def
using
igConsIPresIGWlsSTR_imp_igConsIPresIGWls
igSwapAllIPresIGWlsAllSTR_imp_igSwapAllIPresIGWlsAll
igFreshClsSTR_imp_igFreshCls
igSwapClsSTR_imp_igSwapCls
igAbsCongSSTR_imp_igAbsCongS
by auto
text ‹Well-sorted fresh-subst models:›
definition iwlsFSb where
"iwlsFSb MOD ==
igWlsAllDisj MOD ∧ igWlsAbsIsInBar MOD ∧
igConsIPresIGWls MOD ∧ igSubstAllIPresIGWlsAll MOD ∧
igFreshCls MOD ∧ igSubstCls MOD ∧ igAbsRen MOD"
lemmas iwlsFSb_defs1 = iwlsFSb_def
igWlsAllDisj_def igWlsAbsIsInBar_def
igConsIPresIGWls_def igSubstAllIPresIGWlsAll_def
igFreshCls_def igSubstCls_def igAbsRen_def
lemmas iwlsFSb_defs = iwlsFSb_def
igWlsAllDisj_defs igWlsAbsIsInBar_def
igConsIPresIGWls_defs igSubstAllIPresIGWlsAll_defs
igFreshCls_defs igSubstCls_defs igAbsRen_def
definition iwlsFSbSwTR where
"iwlsFSbSwTR MOD ==
igWlsAllDisj MOD ∧ igWlsAbsIsInBar MOD ∧
igConsIPresIGWlsSTR MOD ∧ igSubstAllIPresIGWlsAllSTR MOD ∧
igFreshClsSTR MOD ∧ igSubstClsSTR MOD ∧ igAbsRenSTR MOD"
lemmas wlsFSbSwSTR_defs1 = iwlsFSbSwTR_def
igWlsAllDisj_def igWlsAbsIsInBar_def
igConsIPresIGWlsSTR_def igSwapAllIPresIGWlsAllSTR_def
igFreshClsSTR_def igSwapClsSTR_def igAbsRenSTR_def
lemmas iwlsFSbSwTR_defs = iwlsFSbSwTR_def
igWlsAllDisj_defs igWlsAbsIsInBar_def
igConsIPresIGWlsSTR_defs igSwapAllIPresIGWlsAllSTR_defs
igFreshClsSTR_defs igSwapClsSTR_defs igAbsRenSTR_def
lemma iwlsFSbSwTR_imp_iwlsFSb:
"iwlsFSbSwTR MOD ⟹ iwlsFSb MOD"
unfolding iwlsFSbSwTR_def iwlsFSb_def
using
igConsIPresIGWlsSTR_imp_igConsIPresIGWls
igSubstAllIPresIGWlsAllSTR_imp_igSubstAllIPresIGWlsAll
igFreshClsSTR_imp_igFreshCls
igSubstClsSTR_imp_igSubstCls
igAbsRenSTR_imp_igAbsRen
by auto
text ‹Well-sorted fresh-swap-subst-models›
definition iwlsFSwSb where
"iwlsFSwSb MOD ==
iwlsFSw MOD ∧ igSubstAllIPresIGWlsAll MOD ∧ igSubstCls MOD"
lemmas iwlsFSwSb_defs1 = iwlsFSwSb_def
iwlsFSw_def igSubstAllIPresIGWlsAll_def igSubstCls_def
lemmas iwlsFSwSb_defs = iwlsFSwSb_def
iwlsFSw_def igSubstAllIPresIGWlsAll_defs igSubstCls_defs
text ‹Well-sorted fresh-subst-swap-models›
definition iwlsFSbSw where
"iwlsFSbSw MOD ==
iwlsFSb MOD ∧ igSwapAllIPresIGWlsAll MOD ∧ igSwapCls MOD"
lemmas iwlsFSbSw_defs1 = iwlsFSbSw_def
iwlsFSw_def igSwapAllIPresIGWlsAll_def igSwapCls_def
lemmas iwlsFSbSw_defs = iwlsFSbSw_def
iwlsFSw_def igSwapAllIPresIGWlsAll_defs igSwapCls_defs
text‹Extension of domain preservation (by swap and subst) to inputs:›
text ‹First for free inputs:›
definition igSwapInpIPresIGWlsInp where
"igSwapInpIPresIGWlsInp MOD ==
∀ zs z1 z2 delta inp.
igWlsInp MOD delta inp ⟶
igWlsInp MOD delta (igSwapInp MOD zs z1 z2 inp)"
definition igSwapInpIPresIGWlsInpSTR where
"igSwapInpIPresIGWlsInpSTR MOD ==
∀ zs z1 z2 delta inp.
igWlsInp MOD delta (igSwapInp MOD zs z1 z2 inp) =
igWlsInp MOD delta inp"
definition igSubstInpIPresIGWlsInp where
"igSubstInpIPresIGWlsInp MOD ==
∀ ys y Y delta inp.
igWls MOD (asSort ys) Y ∧ igWlsInp MOD delta inp ⟶
igWlsInp MOD delta (igSubstInp MOD ys Y y inp)"
definition igSubstInpIPresIGWlsInpSTR where
"igSubstInpIPresIGWlsInpSTR MOD ==
∀ ys y Y delta inp.
igWls MOD (asSort ys) Y ⟶
igWlsInp MOD delta (igSubstInp MOD ys Y y inp) =
igWlsInp MOD delta inp"
lemma imp_igSwapInpIPresIGWlsInp:
"igSwapIPresIGWls MOD ⟹ igSwapInpIPresIGWlsInp MOD"
by (simp add:
igSwapInpIPresIGWlsInp_def igWlsInp_def liftAll2_def
igSwapIPresIGWls_def igSwapAbsIPresIGWlsAbs_def igSwapInp_def lift_def
sameDom_def split: option.splits)
lemma imp_igSwapInpIPresIGWlsInpSTR:
"igSwapIPresIGWlsSTR MOD ⟹ igSwapInpIPresIGWlsInpSTR MOD"
by (simp add:
igSwapIPresIGWlsSTR_def igWlsInp_def liftAll2_def
igSwapIPresIGWls_def igSwapInpIPresIGWlsInpSTR_def igSwapInp_def lift_def
sameDom_def split: option.splits)
(smt option.distinct(1) option.exhaust)
lemma imp_igSubstInpIPresIGWlsInp:
"igSubstIPresIGWls MOD ⟹ igSubstInpIPresIGWlsInp MOD"
by (simp add : igSubstInp_def
igSubstIPresIGWls_def igSubstInpIPresIGWlsInp_def igWlsInp_def liftAll2_def
lift_def sameDom_def split: option.splits)
lemma imp_igSubstInpIPresIGWlsInpSTR:
"igSubstIPresIGWlsSTR MOD ⟹ igSubstInpIPresIGWlsInpSTR MOD"
by(simp add:
igSubstInpIPresIGWlsInpSTR_def igSubstIPresIGWlsSTR_def igSubstInp_def
igWlsInp_def liftAll2_def lift_def sameDom_def
split: option.splits) (smt option.distinct(1) option.exhaust)
text ‹Then for bound inputs:›
definition igSwapBinpIPresIGWlsBinp where
"igSwapBinpIPresIGWlsBinp MOD ==
∀ zs z1 z2 delta binp.
igWlsBinp MOD delta binp ⟶
igWlsBinp MOD delta (igSwapBinp MOD zs z1 z2 binp)"
definition igSwapBinpIPresIGWlsBinpSTR where
"igSwapBinpIPresIGWlsBinpSTR MOD ==
∀ zs z1 z2 delta binp.
igWlsBinp MOD delta (igSwapBinp MOD zs z1 z2 binp) =
igWlsBinp MOD delta binp"
definition igSubstBinpIPresIGWlsBinp where
"igSubstBinpIPresIGWlsBinp MOD ==
∀ ys y Y delta binp.
igWls MOD (asSort ys) Y ∧ igWlsBinp MOD delta binp ⟶
igWlsBinp MOD delta (igSubstBinp MOD ys Y y binp)"
definition igSubstBinpIPresIGWlsBinpSTR where
"igSubstBinpIPresIGWlsBinpSTR MOD ==
∀ ys y Y delta binp.
igWls MOD (asSort ys) Y ⟶
igWlsBinp MOD delta (igSubstBinp MOD ys Y y binp) =
igWlsBinp MOD delta binp"
lemma imp_igSwapBinpIPresIGWlsBinp:
"igSwapAbsIPresIGWlsAbs MOD ⟹ igSwapBinpIPresIGWlsBinp MOD"
by(auto simp add:
igSwapBinpIPresIGWlsBinp_def igSwapAbsIPresIGWlsAbs_def igSwapBinp_def
igWlsBinp_def liftAll2_def lift_def sameDom_def
split: option.splits)
lemma imp_igSwapBinpIPresIGWlsBinpSTR:
"igSwapAbsIPresIGWlsAbsSTR MOD ⟹ igSwapBinpIPresIGWlsBinpSTR MOD"
by (simp add:
igSwapBinpIPresIGWlsBinpSTR_def igSwapAbsIPresIGWlsAbsSTR_def igSwapBinp_def
igWlsBinp_def liftAll2_def lift_def sameDom_def
split: option.splits) (smt option.distinct(1) option.exhaust surj_pair)
lemma imp_igSubstBinpIPresIGWlsBinp:
"igSubstAbsIPresIGWlsAbs MOD ⟹ igSubstBinpIPresIGWlsBinp MOD"
by (auto simp add:
igSubstBinpIPresIGWlsBinp_def igSubstAbsIPresIGWlsAbs_def igSubstBinp_def
igWlsBinp_def liftAll2_def lift_def sameDom_def
split: option.splits)
lemma imp_igSubstBinpIPresIGWlsBinpSTR:
"igSubstAbsIPresIGWlsAbsSTR MOD ⟹ igSubstBinpIPresIGWlsBinpSTR MOD"
by (simp add:
igSubstAbsIPresIGWlsAbsSTR_def igSubstBinpIPresIGWlsBinpSTR_def igSubstBinp_def
igWlsBinp_def liftAll2_def lift_def sameDom_def
split: option.splits) (smt option.distinct(1) option.exhaust surj_pair)
subsection ‹Morphisms of models›
text‹
The morphisms between models shall be the usual first-order-logic morphisms, i.e,, functions
commuting with the operations and preserving the (freshness) relations. Because they involve the
same signature, the morphisms for fresh-swap-subst models (called fresh-swap-subst morphisms)
will be the same as those for fresh-subst-swap-models.
›
subsubsection ‹Preservation of the domains›
definition ipresIGWls where
"ipresIGWls h MOD MOD' ==
∀ s X. igWls MOD s X ⟶ igWls MOD' s (h X)"
definition ipresIGWlsAbs where
"ipresIGWlsAbs hA MOD MOD' ==
∀ us s A. igWlsAbs MOD (us,s) A ⟶ igWlsAbs MOD' (us,s) (hA A)"
definition ipresIGWlsAll where
"ipresIGWlsAll h hA MOD MOD' ==
ipresIGWls h MOD MOD' ∧ ipresIGWlsAbs hA MOD MOD'"
lemmas ipresIGWlsAll_defs = ipresIGWlsAll_def
ipresIGWls_def ipresIGWlsAbs_def
subsubsection ‹Preservation of the constructs›
definition ipresIGVar where
"ipresIGVar h MOD MOD' ==
∀ xs x. h (igVar MOD xs x) = igVar MOD' xs x"
definition ipresIGAbs where
"ipresIGAbs h hA MOD MOD' ==
∀ xs x s X. isInBar (xs,s) ∧ igWls MOD s X ⟶
hA (igAbs MOD xs x X) = igAbs MOD' xs x (h X)"
definition ipresIGOp
where
"ipresIGOp h hA MOD MOD' ==
∀ delta inp binp.
igWlsInp MOD delta inp ∧ igWlsBinp MOD delta binp ⟶
h (igOp MOD delta inp binp) = igOp MOD' delta (lift h inp) (lift hA binp)"
definition ipresIGCons where
"ipresIGCons h hA MOD MOD' ==
ipresIGVar h MOD MOD' ∧
ipresIGAbs h hA MOD MOD' ∧
ipresIGOp h hA MOD MOD'"
lemmas ipresIGCons_defs = ipresIGCons_def
ipresIGVar_def
ipresIGAbs_def
ipresIGOp_def
subsubsection ‹Preservation of freshness›
definition ipresIGFresh where
"ipresIGFresh h MOD MOD' ==
∀ ys y s X.
igWls MOD s X ⟶
igFresh MOD ys y X ⟶ igFresh MOD' ys y (h X)"
definition ipresIGFreshAbs where
"ipresIGFreshAbs hA MOD MOD' ==
∀ ys y us s A.
igWlsAbs MOD (us,s) A ⟶
igFreshAbs MOD ys y A ⟶ igFreshAbs MOD' ys y (hA A)"
definition ipresIGFreshAll where
"ipresIGFreshAll h hA MOD MOD' ==
ipresIGFresh h MOD MOD' ∧ ipresIGFreshAbs hA MOD MOD'"
lemmas ipresIGFreshAll_defs = ipresIGFreshAll_def
ipresIGFresh_def ipresIGFreshAbs_def
subsubsection ‹Preservation of swapping›
definition ipresIGSwap where
"ipresIGSwap h MOD MOD' ==
∀ zs z1 z2 s X.
igWls MOD s X ⟶
h (igSwap MOD zs z1 z2 X) = igSwap MOD' zs z1 z2 (h X)"
definition ipresIGSwapAbs where
"ipresIGSwapAbs hA MOD MOD' ==
∀ zs z1 z2 us s A.
igWlsAbs MOD (us,s) A ⟶
hA (igSwapAbs MOD zs z1 z2 A) = igSwapAbs MOD' zs z1 z2 (hA A)"
definition ipresIGSwapAll where
"ipresIGSwapAll h hA MOD MOD' ==
ipresIGSwap h MOD MOD' ∧ ipresIGSwapAbs hA MOD MOD'"
lemmas ipresIGSwapAll_defs = ipresIGSwapAll_def
ipresIGSwap_def ipresIGSwapAbs_def
subsubsection ‹Preservation of subst›
definition ipresIGSubst where
"ipresIGSubst h MOD MOD' ==
∀ ys Y y s X.
igWls MOD (asSort ys) Y ∧ igWls MOD s X ⟶
h (igSubst MOD ys Y y X) = igSubst MOD' ys (h Y) y (h X)"
definition ipresIGSubstAbs where
"ipresIGSubstAbs h hA MOD MOD' ==
∀ ys Y y us s A.
igWls MOD (asSort ys) Y ∧ igWlsAbs MOD (us,s) A ⟶
hA (igSubstAbs MOD ys Y y A) = igSubstAbs MOD' ys (h Y) y (hA A)"
definition ipresIGSubstAll where
"ipresIGSubstAll h hA MOD MOD' ==
ipresIGSubst h MOD MOD' ∧
ipresIGSubstAbs h hA MOD MOD'"
lemmas ipresIGSubstAll_defs = ipresIGSubstAll_def
ipresIGSubst_def ipresIGSubstAbs_def
subsubsection ‹Fresh-swap morphisms›
definition FSwImorph where
"FSwImorph h hA MOD MOD' ==
ipresIGWlsAll h hA MOD MOD' ∧ ipresIGCons h hA MOD MOD' ∧
ipresIGFreshAll h hA MOD MOD' ∧ ipresIGSwapAll h hA MOD MOD'"
lemmas FSwImorph_defs1 = FSwImorph_def
ipresIGWlsAll_def ipresIGCons_def
ipresIGFreshAll_def ipresIGSwapAll_def
lemmas FSwImorph_defs = FSwImorph_def
ipresIGWlsAll_defs ipresIGCons_defs
ipresIGFreshAll_defs ipresIGSwapAll_defs
subsubsection ‹Fresh-subst morphisms›
definition FSbImorph where
"FSbImorph h hA MOD MOD' ==
ipresIGWlsAll h hA MOD MOD' ∧ ipresIGCons h hA MOD MOD' ∧
ipresIGFreshAll h hA MOD MOD' ∧ ipresIGSubstAll h hA MOD MOD'"
lemmas FSbImorph_defs1 = FSbImorph_def
ipresIGWlsAll_def ipresIGCons_def
ipresIGFreshAll_def ipresIGSubstAll_def
lemmas FSbImorph_defs = FSbImorph_def
ipresIGWlsAll_defs ipresIGCons_defs
ipresIGFreshAll_defs ipresIGSubstAll_defs
subsubsection ‹Fresh-swap-subst morphisms›
definition FSwSbImorph where
"FSwSbImorph h hA MOD MOD' ==
FSwImorph h hA MOD MOD' ∧ ipresIGSubstAll h hA MOD MOD'"
lemmas FSwSbImorph_defs1 = FSwSbImorph_def
FSwImorph_def ipresIGSubstAll_def
lemmas FSwSbImorph_defs = FSwSbImorph_def
FSwImorph_defs ipresIGSubstAll_defs
subsubsection ‹Basic facts›
text ‹FSwSb morphisms are the same as FSbSw morphisms:›
lemma FSwSbImorph_iff:
"FSwSbImorph h hA MOD MOD' =
(FSbImorph h hA MOD MOD' ∧ ipresIGSwapAll h hA MOD MOD')"
unfolding FSwSbImorph_def FSbImorph_def FSwImorph_def by auto
text ‹Some facts for free inpus:›
lemma igSwapInp_None[simp]:
"(igSwapInp MOD zs z1 z2 inp i = None) = (inp i = None)"
unfolding igSwapInp_def by(simp add: lift_None)
lemma igSubstInp_None[simp]:
"(igSubstInp MOD ys Y y inp i = None) = (inp i = None)"
unfolding igSubstInp_def by(simp add: lift_None)
lemma imp_igWlsInp:
"igWlsInp MOD delta inp ⟹ ipresIGWls h MOD MOD'
⟹ igWlsInp MOD' delta (lift h inp)"
by (simp add: igWlsInp_def ipresIGWls_def liftAll2_def lift_def
sameDom_def split: option.splits)
corollary FSwImorph_igWlsInp:
assumes "igWlsInp MOD delta inp" and "FSwImorph h hA MOD MOD'"
shows "igWlsInp MOD' delta (lift h inp)"
using assms unfolding FSwImorph_def ipresIGWlsAll_def
using imp_igWlsInp by auto
corollary FSbImorph_igWlsInp:
assumes "igWlsInp MOD delta inp" and "FSbImorph h hA MOD MOD'"
shows "igWlsInp MOD' delta (lift h inp)"
using assms unfolding FSbImorph_def ipresIGWlsAll_def
using imp_igWlsInp by auto
lemma FSwSbImorph_igWlsInp:
assumes "igWlsInp MOD delta inp" and "FSwSbImorph h hA MOD MOD'"
shows "igWlsInp MOD' delta (lift h inp)"
using assms unfolding FSwSbImorph_def using FSwImorph_igWlsInp by auto
text ‹Similar facts for bound inpus:›
lemma igSwapBinp_None[simp]:
"(igSwapBinp MOD zs z1 z2 binp i = None) = (binp i = None)"
unfolding igSwapBinp_def by(simp add: lift_None)
lemma igSubstBinp_None[simp]:
"(igSubstBinp MOD ys Y y binp i = None) = (binp i = None)"
unfolding igSubstBinp_def by(simp add: lift_None)
lemma imp_igWlsBinp:
assumes *: "igWlsBinp MOD delta binp"
and **: "ipresIGWlsAbs hA MOD MOD'"
shows "igWlsBinp MOD' delta (lift hA binp)"
using assms by (simp add: igWlsBinp_def ipresIGWlsAbs_def liftAll2_def lift_def
sameDom_def split: option.splits)
corollary FSwImorph_igWlsBinp:
assumes "igWlsBinp MOD delta binp" and "FSwImorph h hA MOD MOD'"
shows "igWlsBinp MOD' delta (lift hA binp)"
using assms unfolding FSwImorph_def ipresIGWlsAll_def
using imp_igWlsBinp by auto
corollary FSbImorph_igWlsBinp:
assumes "igWlsBinp MOD delta binp" and "FSbImorph h hA MOD MOD'"
shows "igWlsBinp MOD' delta (lift hA binp)"
using assms unfolding FSbImorph_def ipresIGWlsAll_def
using imp_igWlsBinp by auto
lemma FSwSbImorph_igWlsBinp:
assumes "igWlsBinp MOD delta binp" and "FSwSbImorph h hA MOD MOD'"
shows "igWlsBinp MOD' delta (lift hA binp)"
using assms unfolding FSwSbImorph_def using FSwImorph_igWlsBinp by auto
lemmas input_igSwap_igSubst_None =
igSwapInp_None igSubstInp_None
igSwapBinp_None igSubstBinp_None
subsubsection ‹Identity and composition›
lemma id_FSwImorph: "FSwImorph id id MOD MOD"
unfolding FSwImorph_defs by auto
lemma id_FSbImorph: "FSbImorph id id MOD MOD"
unfolding FSbImorph_defs by auto
lemma id_FSwSbImorph: "FSwSbImorph id id MOD MOD"
unfolding FSwSbImorph_def apply(auto simp add: id_FSwImorph)
unfolding ipresIGSubstAll_defs by auto
lemma comp_ipresIGWls:
assumes "ipresIGWls h MOD MOD'" and "ipresIGWls h' MOD' MOD''"
shows "ipresIGWls (h' o h) MOD MOD''"
using assms unfolding ipresIGWls_def by auto
lemma comp_ipresIGWlsAbs:
assumes "ipresIGWlsAbs hA MOD MOD'" and "ipresIGWlsAbs hA' MOD' MOD''"
shows "ipresIGWlsAbs (hA' o hA) MOD MOD''"
using assms unfolding ipresIGWlsAbs_def by auto
lemma comp_ipresIGWlsAll:
assumes "ipresIGWlsAll h hA MOD MOD'" and "ipresIGWlsAll h' hA' MOD' MOD''"
shows "ipresIGWlsAll (h' o h) (hA' o hA) MOD MOD''"
using assms unfolding ipresIGWlsAll_def
using comp_ipresIGWls comp_ipresIGWlsAbs by auto
lemma comp_ipresIGVar:
assumes "ipresIGVar h MOD MOD'" and "ipresIGVar h' MOD' MOD''"
shows "ipresIGVar (h' o h) MOD MOD''"
using assms unfolding ipresIGVar_def by auto
lemma comp_ipresIGAbs:
assumes "ipresIGWls h MOD MOD'"
and "ipresIGAbs h hA MOD MOD'" and "ipresIGAbs h' hA' MOD' MOD''"
shows "ipresIGAbs (h' o h) (hA' o hA) MOD MOD''"
using assms unfolding ipresIGWls_def ipresIGAbs_def by fastforce
lemma comp_ipresIGOp:
assumes ipres: "ipresIGWls h MOD MOD'" and ipresAbs: "ipresIGWlsAbs hA MOD MOD'"
and h: "ipresIGOp h hA MOD MOD'" and h': "ipresIGOp h' hA' MOD' MOD''"
shows "ipresIGOp (h' o h) (hA' o hA) MOD MOD''"
using assms by (auto simp: imp_igWlsInp imp_igWlsBinp ipresIGOp_def lift_comp)
lemma comp_ipresIGCons:
assumes "ipresIGWlsAll h hA MOD MOD'"
and "ipresIGCons h hA MOD MOD'" and "ipresIGCons h' hA' MOD' MOD''"
shows "ipresIGCons (h' o h) (hA' o hA) MOD MOD''"
using assms unfolding ipresIGWlsAll_def ipresIGCons_def
using comp_ipresIGVar comp_ipresIGAbs comp_ipresIGOp by auto
lemma comp_ipresIGFresh:
assumes "ipresIGWls h MOD MOD'"
and "ipresIGFresh h MOD MOD'" and "ipresIGFresh h' MOD' MOD''"
shows "ipresIGFresh (h' o h) MOD MOD''"
using assms unfolding ipresIGWls_def ipresIGFresh_def by fastforce
lemma comp_ipresIGFreshAbs:
assumes "ipresIGWlsAbs hA MOD MOD'"
and "ipresIGFreshAbs hA MOD MOD'" and "ipresIGFreshAbs hA' MOD' MOD''"
shows "ipresIGFreshAbs (hA' o hA) MOD MOD''"
using assms unfolding ipresIGWlsAbs_def ipresIGFreshAbs_def by fastforce
lemma comp_ipresIGFreshAll:
assumes "ipresIGWlsAll h hA MOD MOD'"
and "ipresIGFreshAll h hA MOD MOD'" and "ipresIGFreshAll h' hA' MOD' MOD''"
shows "ipresIGFreshAll (h' o h) (hA' o hA) MOD MOD''"
using assms
unfolding ipresIGWlsAll_def ipresIGFreshAll_def
using comp_ipresIGFresh comp_ipresIGFreshAbs by auto
lemma comp_ipresIGSwap:
assumes "ipresIGWls h MOD MOD'"
and "ipresIGSwap h MOD MOD'" and "ipresIGSwap h' MOD' MOD''"
shows "ipresIGSwap (h' o h) MOD MOD''"
using assms unfolding ipresIGWls_def ipresIGSwap_def by fastforce
lemma comp_ipresIGSwapAbs:
assumes "ipresIGWlsAbs hA MOD MOD'"
and "ipresIGSwapAbs hA MOD MOD'" and "ipresIGSwapAbs hA' MOD' MOD''"
shows "ipresIGSwapAbs (hA' o hA) MOD MOD''"
using assms unfolding ipresIGWlsAbs_def ipresIGSwapAbs_def by fastforce
lemma comp_ipresIGSwapAll:
assumes "ipresIGWlsAll h hA MOD MOD'"
and "ipresIGSwapAll h hA MOD MOD'" and "ipresIGSwapAll h' hA' MOD' MOD''"
shows "ipresIGSwapAll (h' o h) (hA' o hA) MOD MOD''"
using assms
unfolding ipresIGWlsAll_def ipresIGSwapAll_def
using comp_ipresIGSwap comp_ipresIGSwapAbs by auto
lemma comp_ipresIGSubst:
assumes "ipresIGWls h MOD MOD'"
and "ipresIGSubst h MOD MOD'" and "ipresIGSubst h' MOD' MOD''"
shows "ipresIGSubst (h' o h) MOD MOD''"
using assms unfolding ipresIGWls_def ipresIGSubst_def
apply auto by blast
lemma comp_ipresIGSubstAbs:
assumes *: "igWlsAbsIsInBar MOD"
and h: "ipresIGWls h MOD MOD'" and hA: "ipresIGWlsAbs hA MOD MOD'"
and hhA: "ipresIGSubstAbs h hA MOD MOD'" and h'hA': "ipresIGSubstAbs h' hA' MOD' MOD''"
shows "ipresIGSubstAbs (h' o h) (hA' o hA) MOD MOD''"
using assms by(fastforce simp: igWlsAbsIsInBar_def
ipresIGSubstAbs_def ipresIGWls_def ipresIGWlsAbs_def)
lemma comp_ipresIGSubstAll:
assumes "igWlsAbsIsInBar MOD"
and "ipresIGWlsAll h hA MOD MOD'"
and "ipresIGSubstAll h hA MOD MOD'" and "ipresIGSubstAll h' hA' MOD' MOD''"
shows "ipresIGSubstAll (h' o h) (hA' o hA) MOD MOD''"
using assms unfolding ipresIGWlsAll_def ipresIGSubstAll_def
using comp_ipresIGSubst comp_ipresIGSubstAbs by auto
lemma comp_FSwImorph:
assumes *: "FSwImorph h hA MOD MOD'" and **: "FSwImorph h' hA' MOD' MOD''"
shows "FSwImorph (h' o h) (hA' o hA) MOD MOD''"
using assms unfolding FSwImorph_def
using comp_ipresIGWlsAll comp_ipresIGCons
comp_ipresIGFreshAll comp_ipresIGSwapAll by auto
lemma comp_FSbImorph:
assumes "igWlsAbsIsInBar MOD"
and "FSbImorph h hA MOD MOD'" and "FSbImorph h' hA' MOD' MOD''"
shows "FSbImorph (h' o h) (hA' o hA) MOD MOD''"
using assms unfolding FSbImorph_def
using comp_ipresIGWlsAll comp_ipresIGCons
comp_ipresIGFreshAll comp_ipresIGSubstAll by auto
lemma comp_FSwSbImorph:
assumes "igWlsAbsIsInBar MOD"
and "FSwSbImorph h hA MOD MOD'" and "FSwSbImorph h' hA' MOD' MOD''"
shows "FSwSbImorph (h' o h) (hA' o hA) MOD MOD''"
using assms unfolding FSwSbImorph_def
using comp_FSwImorph FSwImorph_def comp_ipresIGSubstAll FixSyn_axioms by blast
subsection ‹The term model›
text ‹We show that terms form fresh-swap-subst and fresh-subst-swap models.›
subsubsection ‹Definitions and simplification rules›
definition termMOD where
"termMOD ==
⦇igWls = wls, igWlsAbs = wlsAbs,
igVar = Var, igAbs = Abs, igOp = Op,
igFresh = fresh, igFreshAbs = freshAbs,
igSwap = swap, igSwapAbs = swapAbs,
igSubst = subst, igSubstAbs = substAbs⦈"
lemma igWls_termMOD[simp]: "igWls termMOD = wls"
unfolding termMOD_def by simp
lemma igWlsAbs_termMOD[simp]: "igWlsAbs termMOD = wlsAbs"
unfolding termMOD_def by simp
lemma igWlsInp_termMOD_wlsInp[simp]:
"igWlsInp termMOD delta inp = wlsInp delta inp"
unfolding igWlsInp_def wlsInp_iff by simp
lemma igWlsBinp_termMOD_wlsBinp[simp]:
"igWlsBinp termMOD delta binp = wlsBinp delta binp"
unfolding igWlsBinp_def wlsBinp_iff by simp
lemmas igWlsAll_termMOD_simps =
igWls_termMOD igWlsAbs_termMOD
igWlsInp_termMOD_wlsInp igWlsBinp_termMOD_wlsBinp
lemma igVar_termMOD[simp]: "igVar termMOD = Var"
unfolding termMOD_def by simp
lemma igAbs_termMOD[simp]: "igAbs termMOD = Abs"
unfolding termMOD_def by simp
lemma igOp_termMOD[simp]: "igOp termMOD = Op"
unfolding termMOD_def by simp
lemmas igCons_termMOD_simps =
igVar_termMOD igAbs_termMOD igOp_termMOD
lemma igFresh_termMOD[simp]: "igFresh termMOD = fresh"
unfolding termMOD_def by simp
lemma igFreshAbs_termMOD[simp]: "igFreshAbs termMOD = freshAbs"
unfolding termMOD_def by simp
lemma igFreshInp_termMOD[simp]: "igFreshInp termMOD = freshInp"
unfolding igFreshInp_def[abs_def] freshInp_def[abs_def] by simp
lemma igFreshBinp_termMOD[simp]: "igFreshBinp termMOD = freshBinp"
unfolding igFreshBinp_def[abs_def] freshBinp_def[abs_def] by simp
lemmas igFreshAll_termMOD_simps =
igFresh_termMOD igFreshAbs_termMOD
igFreshInp_termMOD igFreshBinp_termMOD
lemma igSwap_termMOD[simp]: "igSwap termMOD = swap"
unfolding termMOD_def by simp
lemma igSwapAbs_termMOD[simp]: "igSwapAbs termMOD = swapAbs"
unfolding termMOD_def by simp
lemma igSwapInp_termMOD[simp]: "igSwapInp termMOD = swapInp"
unfolding igSwapInp_def[abs_def] swapInp_def[abs_def] by simp
lemma igSwapBinp_termMOD[simp]: "igSwapBinp termMOD = swapBinp"
unfolding igSwapBinp_def[abs_def] swapBinp_def[abs_def] by simp
lemmas igSwapAll_termMOD_simps =
igSwap_termMOD igSwapAbs_termMOD
igSwapInp_termMOD igSwapBinp_termMOD
lemma igSubst_termMOD[simp]: "igSubst termMOD = subst"
unfolding termMOD_def by simp
lemma igSubstAbs_termMOD[simp]: "igSubstAbs termMOD = substAbs"
unfolding termMOD_def by simp
lemma igSubstInp_termMOD[simp]: "igSubstInp termMOD = substInp"
by (simp add: igSubstInp_def[abs_def] substInp_def[abs_def]
psubstInp_def[abs_def] subst_def)
lemma igSubstBinp_termMOD[simp]: "igSubstBinp termMOD = substBinp"
by (simp add: igSubstBinp_def[abs_def] substBinp_def[abs_def]
psubstBinp_def[abs_def] substAbs_def)
lemmas igSubstAll_termMOD_simps =
igSubst_termMOD igSubstAbs_termMOD
igSubstInp_termMOD igSubstBinp_termMOD
lemmas structure_termMOD_simps =
igWlsAll_termMOD_simps
igFreshAll_termMOD_simps
igSwapAll_termMOD_simps
igSubstAll_termMOD_simps
subsubsection ‹Well-sortedness of the term model›
text‹Domains are disjoint:›
lemma termMOD_igWlsDisj: "igWlsDisj termMOD"
unfolding igWlsDisj_def using wls_disjoint by auto
lemma termMOD_igWlsAbsDisj: "igWlsAbsDisj termMOD"
unfolding igWlsAbsDisj_def using wlsAbs_disjoint by auto
lemma termMOD_igWlsAllDisj: "igWlsAllDisj termMOD"
unfolding igWlsAllDisj_def
using termMOD_igWlsDisj termMOD_igWlsAbsDisj by simp
text ‹Abstraction domains inhabited only within bound arities:›
lemma termMOD_igWlsAbsIsInBar: "igWlsAbsIsInBar termMOD"
unfolding igWlsAbsIsInBar_def using wlsAbs_nchotomy by simp
text‹The syntactic constructs preserve the domains:›
lemma termMOD_igVarIPresIGWls: "igVarIPresIGWls termMOD"
unfolding igVarIPresIGWls_def by simp
lemma termMOD_igAbsIPresIGWls: "igAbsIPresIGWls termMOD"
unfolding igAbsIPresIGWls_def by simp
lemma termMOD_igOpIPresIGWls: "igOpIPresIGWls termMOD"
unfolding igOpIPresIGWls_def by simp
lemma termMOD_igConsIPresIGWls: "igConsIPresIGWls termMOD"
unfolding igConsIPresIGWls_def
using termMOD_igVarIPresIGWls termMOD_igAbsIPresIGWls termMOD_igOpIPresIGWls
by auto
text‹Swap preserves the domains:›
lemma termMOD_igSwapIPresIGWls: "igSwapIPresIGWls termMOD"
unfolding igSwapIPresIGWls_def by simp
lemma termMOD_igSwapAbsIPresIGWlsAbs: "igSwapAbsIPresIGWlsAbs termMOD"
unfolding igSwapAbsIPresIGWlsAbs_def by simp
lemma termMOD_igSwapAllIPresIGWlsAll: "igSwapAllIPresIGWlsAll termMOD"
unfolding igSwapAllIPresIGWlsAll_def
using termMOD_igSwapIPresIGWls termMOD_igSwapAbsIPresIGWlsAbs by auto
text‹``Subst" preserves the domains:›
lemma termMOD_igSubstIPresIGWls: "igSubstIPresIGWls termMOD"
unfolding igSubstIPresIGWls_def by simp
lemma termMOD_igSubstAbsIPresIGWlsAbs: "igSubstAbsIPresIGWlsAbs termMOD"
unfolding igSubstAbsIPresIGWlsAbs_def by simp
lemma termMOD_igSubstAllIPresIGWlsAll: "igSubstAllIPresIGWlsAll termMOD"
unfolding igSubstAllIPresIGWlsAll_def
using termMOD_igSubstIPresIGWls termMOD_igSubstAbsIPresIGWlsAbs by auto
text‹The ``fresh" clauses hold:›
lemma termMOD_igFreshIGVar: "igFreshIGVar termMOD"
unfolding igFreshIGVar_def by simp
lemma termMOD_igFreshIGAbs1: "igFreshIGAbs1 termMOD"
unfolding igFreshIGAbs1_def by auto
lemma termMOD_igFreshIGAbs2: "igFreshIGAbs2 termMOD"
unfolding igFreshIGAbs2_def by auto
lemma termMOD_igFreshIGOp: "igFreshIGOp termMOD"
unfolding igFreshIGOp_def by simp
lemma termMOD_igFreshCls: "igFreshCls termMOD"
unfolding igFreshCls_def
using termMOD_igFreshIGVar termMOD_igFreshIGAbs1 termMOD_igFreshIGAbs2 termMOD_igFreshIGOp
by simp
text‹The ``swap" clauses hold:›
lemma termMOD_igSwapIGVar: "igSwapIGVar termMOD"
unfolding igSwapIGVar_def by simp
lemma termMOD_igSwapIGAbs: "igSwapIGAbs termMOD"
unfolding igSwapIGAbs_def by auto
lemma termMOD_igSwapIGOp: "igSwapIGOp termMOD"
unfolding igSwapIGOp_def by simp
lemma termMOD_igSwapCls: "igSwapCls termMOD"
unfolding igSwapCls_def
using termMOD_igSwapIGVar termMOD_igSwapIGAbs termMOD_igSwapIGOp by simp
text‹The ``subst" clauses hold:›
lemma termMOD_igSubstIGVar1: "igSubstIGVar1 termMOD"
unfolding igSubstIGVar1_def by auto
lemma termMOD_igSubstIGVar2: "igSubstIGVar2 termMOD"
unfolding igSubstIGVar2_def by auto
lemma termMOD_igSubstIGAbs: "igSubstIGAbs termMOD"
unfolding igSubstIGAbs_def by auto
lemma termMOD_igSubstIGOp: "igSubstIGOp termMOD"
unfolding igSubstIGOp_def by simp
lemma termMOD_igSubstCls: "igSubstCls termMOD"
unfolding igSubstCls_def
using termMOD_igSubstIGVar1 termMOD_igSubstIGVar2
termMOD_igSubstIGAbs termMOD_igSubstIGOp by simp
text‹The swap-congruence clause for abstractions holds:›
lemma termMOD_igAbsCongS: "igAbsCongS termMOD"
unfolding igAbsCongS_def using wls_Abs_swap_cong
by (metis igAbs_termMOD igFresh_termMOD igSwap_termMOD igWls_termMOD)
text‹The subst-renaming clause for abstractions holds:›
lemma termMOD_igAbsRen: "igAbsRen termMOD"
unfolding igAbsRen_def by auto
lemma termMOD_iwlsFSw: "iwlsFSw termMOD"
unfolding iwlsFSw_def
using
termMOD_igWlsAllDisj termMOD_igWlsAbsIsInBar
termMOD_igConsIPresIGWls termMOD_igSwapAllIPresIGWlsAll
termMOD_igFreshCls termMOD_igSwapCls termMOD_igAbsCongS
by auto
lemma termMOD_iwlsFSb: "iwlsFSb termMOD"
unfolding iwlsFSb_def
using
termMOD_igWlsAllDisj termMOD_igWlsAbsIsInBar
termMOD_igConsIPresIGWls termMOD_igSubstAllIPresIGWlsAll
termMOD_igFreshCls termMOD_igSubstCls termMOD_igAbsRen
by auto
lemma termMOD_iwlsFSwSb: "iwlsFSwSb termMOD"
unfolding iwlsFSwSb_def
using termMOD_iwlsFSw termMOD_igSubstAllIPresIGWlsAll termMOD_igSubstCls
by simp
lemma termMOD_iwlsFSbSw: "iwlsFSbSw termMOD"
unfolding iwlsFSbSw_def
using termMOD_iwlsFSb termMOD_igSwapAllIPresIGWlsAll termMOD_igSwapCls
by simp
subsubsection ‹Direct description of morphisms from the term models›
definition ipresWls where
"ipresWls h MOD ==
∀ s X. wls s X ⟶ igWls MOD s (h X)"
lemma ipresIGWls_termMOD[simp]:
"ipresIGWls h termMOD MOD = ipresWls h MOD"
unfolding ipresIGWls_def ipresWls_def by simp
definition ipresWlsAbs where
"ipresWlsAbs hA MOD ==
∀ us s A. wlsAbs (us,s) A ⟶ igWlsAbs MOD (us,s) (hA A)"
lemma ipresIGWlsAbs_termMOD[simp]:
"ipresIGWlsAbs hA termMOD MOD = ipresWlsAbs hA MOD"
unfolding ipresIGWlsAbs_def ipresWlsAbs_def by simp
definition ipresWlsAll where
"ipresWlsAll h hA MOD ==
ipresWls h MOD ∧ ipresWlsAbs hA MOD"
lemmas ipresWlsAll_defs = ipresWlsAll_def
ipresWls_def ipresWlsAbs_def
lemma ipresIGWlsAll_termMOD[simp]:
"ipresIGWlsAll h hA termMOD MOD = ipresWlsAll h hA MOD"
unfolding ipresIGWlsAll_def ipresWlsAll_def by simp
lemmas ipresIGWlsAll_termMOD_simps =
ipresIGWls_termMOD ipresIGWlsAbs_termMOD ipresIGWlsAll_termMOD
definition ipresVar where
"ipresVar h MOD ==
∀ xs x. h (Var xs x) = igVar MOD xs x"
lemma ipresIGVar_termMOD[simp]:
"ipresIGVar h termMOD MOD = ipresVar h MOD"
unfolding ipresIGVar_def ipresVar_def by simp
definition ipresAbs where
"ipresAbs h hA MOD ==
∀ xs x s X. isInBar (xs,s) ∧ wls s X ⟶ hA (Abs xs x X) = igAbs MOD xs x (h X)"
lemma ipresIGAbs_termMOD[simp]:
"ipresIGAbs h hA termMOD MOD = ipresAbs h hA MOD"
unfolding ipresIGAbs_def ipresAbs_def by simp
definition ipresOp where
"ipresOp h hA MOD ==
∀ delta inp binp.
wlsInp delta inp ∧ wlsBinp delta binp ⟶
h (Op delta inp binp) =
igOp MOD delta (lift h inp) (lift hA binp)"
lemma ipresIGOp_termMOD[simp]:
"ipresIGOp h hA termMOD MOD = ipresOp h hA MOD"
unfolding ipresIGOp_def ipresOp_def by simp
definition ipresCons where
"ipresCons h hA MOD ==
ipresVar h MOD ∧
ipresAbs h hA MOD ∧
ipresOp h hA MOD"
lemmas ipresCons_defs = ipresCons_def
ipresVar_def
ipresAbs_def
ipresOp_def
lemma ipresIGCons_termMOD[simp]:
"ipresIGCons h hA termMOD MOD = ipresCons h hA MOD"
unfolding ipresIGCons_def ipresCons_def by simp
lemmas ipresIGCons_termMOD_simps =
ipresIGVar_termMOD ipresIGAbs_termMOD ipresIGOp_termMOD
ipresIGCons_termMOD
definition ipresFresh where
"ipresFresh h MOD ==
∀ ys y s X.
wls s X ⟶
fresh ys y X ⟶ igFresh MOD ys y (h X)"
lemma ipresIGFresh_termMOD[simp]:
"ipresIGFresh h termMOD MOD = ipresFresh h MOD"
unfolding ipresIGFresh_def ipresFresh_def by simp
definition ipresFreshAbs where
"ipresFreshAbs hA MOD ==
∀ ys y us s A.
wlsAbs (us,s) A ⟶
freshAbs ys y A ⟶ igFreshAbs MOD ys y (hA A)"
lemma ipresIGFreshAbs_termMOD[simp]:
"ipresIGFreshAbs hA termMOD MOD = ipresFreshAbs hA MOD"
unfolding ipresIGFreshAbs_def ipresFreshAbs_def by simp
definition ipresFreshAll where
"ipresFreshAll h hA MOD ==
ipresFresh h MOD ∧ ipresFreshAbs hA MOD"
lemmas ipresFreshAll_defs = ipresFreshAll_def
ipresFresh_def ipresFreshAbs_def
lemma ipresIGFreshAll_termMOD[simp]:
"ipresIGFreshAll h hA termMOD MOD = ipresFreshAll h hA MOD"
unfolding ipresIGFreshAll_def ipresFreshAll_def by simp
lemmas ipresIGFreshAll_termMOD_simps =
ipresIGFresh_termMOD ipresIGFreshAbs_termMOD ipresIGFreshAll_termMOD
definition ipresSwap where
"ipresSwap h MOD ==
∀ zs z1 z2 s X.
wls s X ⟶
h (X #[z1 ∧ z2]_zs) = igSwap MOD zs z1 z2 (h X)"
lemma ipresIGSwap_termMOD[simp]:
"ipresIGSwap h termMOD MOD = ipresSwap h MOD"
unfolding ipresIGSwap_def ipresSwap_def by simp
definition ipresSwapAbs where
"ipresSwapAbs hA MOD ==
∀ zs z1 z2 us s A.
wlsAbs (us,s) A ⟶
hA (A $[z1 ∧ z2]_zs) = igSwapAbs MOD zs z1 z2 (hA A)"
lemma ipresIGSwapAbs_termMOD[simp]:
"ipresIGSwapAbs hA termMOD MOD = ipresSwapAbs hA MOD"
unfolding ipresIGSwapAbs_def ipresSwapAbs_def by simp
definition ipresSwapAll where
"ipresSwapAll h hA MOD ==
ipresSwap h MOD ∧ ipresSwapAbs hA MOD"
lemmas ipresSwapAll_defs = ipresSwapAll_def
ipresSwap_def ipresSwapAbs_def
lemma ipresIGSwapAll_termMOD[simp]:
"ipresIGSwapAll h hA termMOD MOD = ipresSwapAll h hA MOD"
unfolding ipresIGSwapAll_def ipresSwapAll_def by simp
lemmas ipresIGSwapAll_termMOD_simps =
ipresIGSwap_termMOD ipresIGSwapAbs_termMOD ipresIGSwapAll_termMOD
definition ipresSubst where
"ipresSubst h MOD ==
∀ ys Y y s X.
wls (asSort ys) Y ∧ wls s X ⟶
h (subst ys Y y X) = igSubst MOD ys (h Y) y (h X)"
lemma ipresIGSubst_termMOD[simp]:
"ipresIGSubst h termMOD MOD = ipresSubst h MOD"
unfolding ipresIGSubst_def ipresSubst_def by simp
definition ipresSubstAbs where
"ipresSubstAbs h hA MOD ==
∀ ys Y y us s A.
wls (asSort ys) Y ∧ wlsAbs (us,s) A ⟶
hA (A $[Y / y]_ys) = igSubstAbs MOD ys (h Y) y (hA A)"
lemma ipresIGSubstAbs_termMOD[simp]:
"ipresIGSubstAbs h hA termMOD MOD = ipresSubstAbs h hA MOD"
unfolding ipresIGSubstAbs_def ipresSubstAbs_def by simp
definition ipresSubstAll where
"ipresSubstAll h hA MOD ==
ipresSubst h MOD ∧ ipresSubstAbs h hA MOD"
lemmas ipresSubstAll_defs = ipresSubstAll_def
ipresSubst_def ipresSubstAbs_def
lemma ipresIGSubstAll_termMOD[simp]:
"ipresIGSubstAll h hA termMOD MOD = ipresSubstAll h hA MOD"
unfolding ipresIGSubstAll_def ipresSubstAll_def by simp
lemmas ipresIGSubstAll_termMOD_simps =
ipresIGSubst_termMOD ipresIGSubstAbs_termMOD ipresIGSubstAll_termMOD
definition termFSwImorph where
"termFSwImorph h hA MOD ==
ipresWlsAll h hA MOD ∧ ipresCons h hA MOD ∧
ipresFreshAll h hA MOD ∧ ipresSwapAll h hA MOD"
lemmas termFSwImorph_defs1 = termFSwImorph_def
ipresWlsAll_def ipresCons_def
ipresFreshAll_def ipresSwapAll_def
lemmas termFSwImorph_defs = termFSwImorph_def
ipresWlsAll_defs ipresCons_defs
ipresFreshAll_defs ipresSwapAll_defs
lemma FSwImorph_termMOD[simp]:
"FSwImorph h hA termMOD MOD = termFSwImorph h hA MOD"
unfolding FSwImorph_def termFSwImorph_def by simp
definition termFSbImorph where
"termFSbImorph h hA MOD ==
ipresWlsAll h hA MOD ∧ ipresCons h hA MOD ∧
ipresFreshAll h hA MOD ∧ ipresSubstAll h hA MOD"
lemmas termFSbImorph_defs1 = termFSbImorph_def
ipresWlsAll_def ipresCons_def
ipresFreshAll_def ipresSubstAll_def
lemmas termFSbImorph_defs = termFSbImorph_def
ipresWlsAll_defs ipresCons_defs
ipresFreshAll_defs ipresSubstAll_defs
lemma FSbImorph_termMOD[simp]:
"FSbImorph h hA termMOD MOD = termFSbImorph h hA MOD"
unfolding FSbImorph_def termFSbImorph_def by simp
definition termFSwSbImorph where
"termFSwSbImorph h hA MOD ==
termFSwImorph h hA MOD ∧ ipresSubstAll h hA MOD"
lemmas termFSwSbImorph_defs1 = termFSwSbImorph_def
termFSwImorph_def ipresSubstAll_def
lemmas termFSwSbImorph_defs = termFSwSbImorph_def
termFSwImorph_defs ipresSubstAll_defs
text ‹Term FSwSb morphisms are the same as FSbSw morphisms:›
lemma termFSwSbImorph_iff:
"termFSwSbImorph h hA MOD =
(termFSbImorph h hA MOD ∧ ipresSwapAll h hA MOD)"
unfolding termFSwSbImorph_def termFSwImorph_def termFSbImorph_def ipresSubstAll_def
unfolding FSwSbImorph_def FSbImorph_def FSwImorph_def by auto
lemma FSwSbImorph_termMOD[simp]:
"FSwSbImorph h hA termMOD MOD = termFSwSbImorph h hA MOD"
unfolding FSwSbImorph_def termFSwSbImorph_def by simp
lemma ipresWls_wlsInp:
assumes "wlsInp delta inp" and "ipresWls h MOD"
shows "igWlsInp MOD delta (lift h inp)"
using assms imp_igWlsInp[of termMOD delta inp h MOD] by auto
lemma termFSwImorph_wlsInp:
assumes "wlsInp delta inp" and "termFSwImorph h hA MOD"
shows "igWlsInp MOD delta (lift h inp)"
using assms FSwImorph_igWlsInp[of termMOD delta inp h hA MOD] by auto
lemma termFSwSbImorph_wlsInp:
assumes "wlsInp delta inp" and "termFSwSbImorph h hA MOD"
shows "igWlsInp MOD delta (lift h inp)"
using assms FSwSbImorph_igWlsInp[of termMOD delta inp h hA MOD] by auto
lemma ipresWls_wlsBinp:
assumes "wlsBinp delta binp" and "ipresWlsAbs hA MOD"
shows "igWlsBinp MOD delta (lift hA binp)"
using assms imp_igWlsBinp[of termMOD delta binp hA MOD] by auto
lemma termFSwImorph_wlsBinp:
assumes "wlsBinp delta binp" and "termFSwImorph h hA MOD"
shows "igWlsBinp MOD delta (lift hA binp)"
using assms FSwImorph_igWlsBinp[of termMOD delta binp h hA MOD] by auto
lemma termFSwSbImorph_wlsBinp:
assumes "wlsBinp delta binp" and "termFSwSbImorph h hA MOD"
shows "igWlsBinp MOD delta (lift hA binp)"
using assms FSwSbImorph_igWlsBinp[of termMOD delta binp h hA MOD] by auto
lemma id_termFSwImorph: "termFSwImorph id id termMOD"
using id_FSwImorph[of termMOD] by simp
lemma id_termFSbImorph: "termFSbImorph id id termMOD"
using id_FSbImorph[of termMOD] by simp
lemma id_termFSwSbImorph: "termFSwSbImorph id id termMOD"
using id_FSwSbImorph[of termMOD] by simp
lemma comp_termFSwImorph:
assumes *: "termFSwImorph h hA MOD" and **: "FSwImorph h' hA' MOD MOD'"
shows "termFSwImorph (h' o h) (hA' o hA) MOD'"
using assms comp_FSwImorph[of h hA termMOD MOD h' hA' MOD'] by auto
lemma comp_termFSbImorph:
assumes *: "termFSbImorph h hA MOD" and **: "FSbImorph h' hA' MOD MOD'"
shows "termFSbImorph (h' o h) (hA' o hA) MOD'"
using assms comp_FSbImorph[of termMOD h hA MOD h' hA' MOD']
termMOD_igWlsAbsIsInBar by auto
lemma comp_termFSwSbImorph:
assumes *: "termFSwSbImorph h hA MOD" and **: "FSwSbImorph h' hA' MOD MOD'"
shows "termFSwSbImorph (h' o h) (hA' o hA) MOD'"
using assms comp_FSwSbImorph[of termMOD h hA MOD h' hA' MOD']
termMOD_igWlsAbsIsInBar by auto
lemmas mapFrom_termMOD_simps =
ipresIGWlsAll_termMOD_simps
ipresIGCons_termMOD_simps
ipresIGFreshAll_termMOD_simps
ipresIGSwapAll_termMOD_simps
ipresIGSubstAll_termMOD_simps
FSwImorph_termMOD FSbImorph_termMOD FSwSbImorph_termMOD
lemmas termMOD_simps =
structure_termMOD_simps mapFrom_termMOD_simps
subsubsection
‹Sufficient criteria for being a morphism
to a well-sorted model (of various kinds)›
text‹In a nutshell: in these cases, we only need to check preservation of the
syntactic constructs, ``ipresCons".›
lemma ipresCons_imp_ipresWlsAll:
assumes *: "ipresCons h hA MOD" and **: "igConsIPresIGWls MOD"
shows "ipresWlsAll h hA MOD"
proof-
{fix s X us s' A
have "(wls s X ⟶ igWls MOD s (h X)) ∧
(wlsAbs (us,s') A ⟶ igWlsAbs MOD (us,s') (hA A))"
proof(induction rule: wls_rawInduct)
case (Var xs x)
then show ?case
by (metis assms igConsIPresIGWls_def igVarIPresIGWls_def ipresCons_def ipresVar_def)
next
case (Op delta inp binp)
have "igWlsInp MOD delta (lift h inp) ∧ igWlsBinp MOD delta (lift hA binp)"
using Op unfolding igWlsInp_def igWlsBinp_def wlsInp_iff wlsBinp_iff
by simp (simp add: liftAll2_def lift_def split: option.splits)
hence "igWls MOD (stOf delta) (igOp MOD delta (lift h inp) (lift hA binp))"
using ** unfolding igConsIPresIGWls_def igOpIPresIGWls_def by simp
thus ?case using Op * unfolding ipresCons_def ipresOp_def by simp
next
case (Abs s xs x X)
then show ?case
by (metis assms igAbsIPresIGWls_def igConsIPresIGWls_def ipresAbs_def ipresCons_def)
qed
}
thus ?thesis unfolding ipresWlsAll_defs by simp
qed
lemma ipresCons_imp_ipresFreshAll:
assumes *: "ipresCons h hA MOD" and **: "igFreshCls MOD"
and "igConsIPresIGWls MOD"
shows "ipresFreshAll h hA MOD"
proof-
have ***: "ipresWlsAll h hA MOD"
using assms ipresCons_imp_ipresWlsAll by auto
hence ****:
"⋀ delta inp. wlsInp delta inp ⟹ igWlsInp MOD delta (lift h inp)"
"⋀ delta binp. wlsBinp delta binp ⟹ igWlsBinp MOD delta (lift hA binp)"
unfolding ipresWlsAll_def using ipresWls_wlsInp ipresWls_wlsBinp by auto
{fix s X us s' A ys y
have "(wls s X ⟶ fresh ys y X ⟶ igFresh MOD ys y (h X)) ∧
(wlsAbs (us,s') A ⟶ freshAbs ys y A ⟶ igFreshAbs MOD ys y (hA A))"
proof(induction rule: wls_rawInduct)
case (Var xs x)
then show ?case
by (metis * ** fresh_Var_simp igFreshCls_def igFreshIGVar_def ipresCons_def ipresVar_def)
next
case (Op delta inp binp)
show ?case proof safe
assume y_fresh: "fresh ys y (Op delta inp binp)"
{fix i X assume inp: "inp i = Some X"
then obtain s where "arOf delta i = Some s"
using Op unfolding wlsInp_iff sameDom_def by fastforce
hence "igFresh MOD ys y (h X)"
using Op.IH y_fresh inp unfolding freshInp_def liftAll_def liftAll2_def
by (metis freshInp_def liftAll_def wls_fresh_Op_simp)
}
moreover
{fix i A assume binp: "binp i = Some A"
then obtain us_s where "barOf delta i = Some us_s"
using Op unfolding wlsBinp_iff sameDom_def by force
hence "igFreshAbs MOD ys y (hA A)"
using Op.IH y_fresh binp unfolding freshBinp_def liftAll_def liftAll2_def
by simp (metis (no_types, hide_lams) freshBinp_def liftAll_def old.prod.exhaust)
}
ultimately have "igFreshInp MOD ys y (lift h inp) ∧ igFreshBinp MOD ys y (lift hA binp)"
unfolding igFreshInp_def igFreshBinp_def liftAll_lift_comp unfolding liftAll_def by auto
moreover have "igWlsInp MOD delta (lift h inp) ∧ igWlsBinp MOD delta (lift hA binp)"
using Op **** by simp
ultimately have "igFresh MOD ys y (igOp MOD delta (lift h inp) (lift hA binp))"
using ** unfolding igFreshCls_def igFreshIGOp_def by simp
thus "igFresh MOD ys y (h (Op delta inp binp))"
using Op * unfolding ipresCons_def ipresOp_def by simp
qed
next
case (Abs s xs x X)
hence hX_wls: "igWls MOD s (h X)"
using *** unfolding ipresWlsAll_def ipresWls_def by simp
thus ?case
using Abs assms by (cases "ys = xs ∧ y = x")
(simp_all add: igFreshCls_def igFreshIGAbs1_def igFreshIGAbs2_def ipresAbs_def ipresCons_def)
qed
}
thus ?thesis unfolding ipresFreshAll_defs by auto
qed
lemma ipresCons_imp_ipresSwapAll:
assumes *: "ipresCons h hA MOD" and **: "igSwapCls MOD"
and "igConsIPresIGWls MOD"
shows "ipresSwapAll h hA MOD"
proof-
have ***: "ipresWlsAll h hA MOD"
using assms ipresCons_imp_ipresWlsAll by auto
hence ****:
"⋀ delta inp. wlsInp delta inp ⟹ igWlsInp MOD delta (lift h inp)"
"⋀ delta binp. wlsBinp delta binp ⟹ igWlsBinp MOD delta (lift hA binp)"
unfolding ipresWlsAll_def using ipresWls_wlsInp ipresWls_wlsBinp by auto
{fix s X us s' A zs z1 z2
have "(wls s X ⟶ h (swap zs z1 z2 X) = igSwap MOD zs z1 z2 (h X)) ∧
(wlsAbs (us,s') A ⟶ hA (swapAbs zs z1 z2 A) = igSwapAbs MOD zs z1 z2 (hA A))"
proof(induction rule: wls_rawInduct)
case (Var xs x)
then show ?case
by (metis "*" "**" igSwapCls_def igSwapIGVar_def ipresCons_def ipresVar_def swap_Var_simp)
next
case (Op delta inp binp)
let ?inpsw = "swapInp zs z1 z2 inp" let ?binpsw = "swapBinp zs z1 z2 binp"
let ?Left = "h (Op delta ?inpsw ?binpsw)"
let ?Right = "igSwap MOD zs z1 z2 (h (Op delta inp binp))"
have wlsLiftInp:
"igWlsInp MOD delta (lift h inp) ∧ igWlsBinp MOD delta (lift hA binp)"
using Op **** by simp
have "wlsInp delta ?inpsw ∧ wlsBinp delta ?binpsw"
using Op by simp
hence "?Left = igOp MOD delta (lift h ?inpsw) (lift hA ?binpsw)"
using * unfolding ipresCons_def ipresOp_def by simp
moreover
have "lift h ?inpsw = igSwapInp MOD zs z1 z2 (lift h inp) ∧
lift hA ?binpsw = igSwapBinp MOD zs z1 z2 (lift hA binp)"
using Op * not_None_eq
by (simp add: igSwapCls_def igSwapIGOp_def wlsInp_iff wlsBinp_iff
swapInp_def swapBinp_def igSwapInp_def igSwapBinp_def
lift_comp fun_eq_iff liftAll2_def lift_def sameDom_def split: option.splits)
(metis not_None_eq old.prod.exhaust)
moreover
have "igOp MOD delta (igSwapInp MOD zs z1 z2 (lift h inp))
(igSwapBinp MOD zs z1 z2 (lift hA binp)) =
igSwap MOD zs z1 z2 (igOp MOD delta (lift h inp) (lift hA binp))"
using wlsLiftInp ** unfolding igSwapCls_def igSwapIGOp_def by simp
moreover
have "igSwap MOD zs z1 z2 (igOp MOD delta (lift h inp) (lift hA binp)) = ?Right"
using Op * unfolding ipresCons_def ipresOp_def by simp
ultimately have "?Left = ?Right" by simp
then show ?case by (simp add: Op)
next
case (Abs s xs x X)
let ?Xsw = "swap zs z1 z2 X" let ?xsw = "x @xs[z1 ∧ z2]_zs"
have hX: "igWls MOD s (h X)" using Abs.IH *** unfolding ipresWlsAll_def ipresWls_def by simp
let ?Left = "hA (Abs xs ?xsw ?Xsw)"
let ?Right = "igSwapAbs MOD zs z1 z2 (hA (Abs xs x X))"
have "wls s (swap zs z1 z2 X)" using Abs by simp
hence "?Left = igAbs MOD xs ?xsw (h ?Xsw)"
using Abs * unfolding ipresCons_def ipresAbs_def by blast
also note Abs(3)
also have "igAbs MOD xs ?xsw (igSwap MOD zs z1 z2 (h X)) =
igSwapAbs MOD zs z1 z2 (igAbs MOD xs x (h X))"
using Abs hX ** by (auto simp: igSwapCls_def igSwapIGAbs_def)
also have "… = ?Right" using Abs * by (auto simp: ipresCons_def ipresAbs_def)
finally have "?Left = ?Right" .
then show ?case using Abs(2) by auto
qed
}
thus ?thesis unfolding ipresSwapAll_defs by auto
qed
lemma ipresCons_imp_ipresSubstAll_aux:
assumes *: "ipresCons h hA MOD" and **: "igSubstCls MOD"
and "igConsIPresIGWls MOD" and "igFreshCls MOD"
assumes P: "wlsPar P"
shows
"(wls s X ⟶
(∀ ys y Y. y ∈ varsOfS P ys ∧ Y ∈ termsOfS P (asSort ys) ⟶
h (X #[Y / y]_ys) = igSubst MOD ys (h Y) y (h X)))
∧
(wlsAbs (us,s') A ⟶
(∀ ys y Y. y ∈ varsOfS P ys ∧ Y ∈ termsOfS P (asSort ys) ⟶
hA (A $[Y / y]_ys) = igSubstAbs MOD ys (h Y) y (hA A)))"
proof-
have ***: "ipresWlsAll h hA MOD"
using assms ipresCons_imp_ipresWlsAll by auto
hence ****:
"⋀ delta inp. wlsInp delta inp ⟹ igWlsInp MOD delta (lift h inp)"
"⋀ delta binp. wlsBinp delta binp ⟹ igWlsBinp MOD delta (lift hA binp)"
unfolding ipresWlsAll_def using ipresWls_wlsInp ipresWls_wlsBinp by auto
have *****: "ipresFreshAll h hA MOD"
using assms ipresCons_imp_ipresFreshAll by auto
show ?thesis
proof(induction rule: wls_induct_fresh[of P])
case Par
then show ?case using P by auto
next
case (Var xs x)
then show ?case using assms
by (simp add: ipresWlsAll_def ipresWls_def igSubstCls_def igSubstIGVar2_def
ipresCons_def ipresVar_def)
(metis "***" FixSyn.ipresWlsAll_defs(1) FixSyn.ipresWlsAll_defs(2) FixSyn_axioms
igSubstIGVar1_def wlsPar_def wls_subst_Var_simp1 wls_subst_Var_simp2)
next
case (Op delta inp binp)
show ?case proof safe
fix ys y Y
assume yP: "y ∈ varsOfS P ys" and YP: "Y ∈ termsOfS P (asSort ys)"
hence Y: "wls (asSort ys) Y" using P by auto
hence hY: "igWls MOD (asSort ys) (h Y)"
using *** unfolding ipresWlsAll_def ipresWls_def by simp
have sinp: "wlsInp delta (substInp ys Y y inp) ∧
wlsBinp delta (substBinp ys Y y binp)" using Y Op by simp
have liftInp: "igWlsInp MOD delta (lift h inp) ∧
igWlsBinp MOD delta (lift hA binp)"
using Op **** by simp
let ?Left = "h ((Op delta inp binp) #[Y / y]_ys)"
let ?Right = "igSubst MOD ys (h Y) y (h (Op delta inp binp))"
have "?Left = igOp MOD delta (lift h (substInp ys Y y inp))
(lift hA (substBinp ys Y y binp))"
using sinp * unfolding ipresCons_def ipresOp_def
by (simp add: Op.IH(1) Op.IH(2) Y)
moreover
have "lift h (substInp ys Y y inp) = igSubstInp MOD ys (h Y) y (lift h inp) ∧
lift hA (substBinp ys Y y binp) = igSubstBinp MOD ys (h Y) y (lift hA binp)"
using Op YP yP by (simp add: substInp_def2 igSubstInp_def substBinp_def2 igSubstBinp_def lift_comp
lift_def liftAll2_def fun_eq_iff wlsInp_iff wlsBinp_iff sameDom_def split: option.splits)
(metis (no_types, hide_lams) not_Some_eq option.distinct(1) sinp wlsBinp.simps)
moreover
have "igOp MOD delta (igSubstInp MOD ys (h Y) y (lift h inp))
(igSubstBinp MOD ys (h Y) y (lift hA binp)) =
igSubst MOD ys (h Y) y (igOp MOD delta (lift h inp) (lift hA binp))"
using hY liftInp ** unfolding igSubstCls_def igSubstIGOp_def by simp
moreover have "… = ?Right" using Op * unfolding ipresCons_def ipresOp_def by simp
ultimately show "?Left = ?Right" by simp
qed
next
case (Abs s xs x X)
show ?case proof safe
fix ys y Y
assume yP: "y ∈ varsOfS P ys" and YP: "Y ∈ termsOfS P (asSort ys)"
hence x_diff: "ys ≠ xs ∨ y ≠ x"
and Y: "wls (asSort ys) Y" and x_fresh: "fresh xs x Y" using P Abs by auto
hence hY: "igWls MOD (asSort ys) (h Y)"
using *** unfolding ipresWlsAll_def ipresWls_def by simp
have hX: "igWls MOD s (h X)"
using Abs *** unfolding ipresWlsAll_def ipresWls_def by simp
let ?Xsb = "subst ys Y y X"
have Xsb: "wls s ?Xsb" using Y Abs by simp
have x_igFresh: "igFresh MOD xs x (h Y)"
using Y x_fresh ***** unfolding ipresFreshAll_def ipresFresh_def by simp
let ?Left = "hA (Abs xs x X $[Y / y]_ys)"
let ?Right = "igSubstAbs MOD ys (h Y) y (hA (Abs xs x X))"
have "?Left = hA (Abs xs x ?Xsb)" using Y Abs x_diff x_fresh by auto
also have "… = igAbs MOD xs x (h ?Xsb)"
using Abs Xsb * unfolding ipresCons_def ipresAbs_def by fastforce
also have "… = igAbs MOD xs x (igSubst MOD ys (h Y) y (h X))"
using yP YP Abs.IH by simp
also have "… = igSubstAbs MOD ys (h Y) y (igAbs MOD xs x (h X))"
using Abs hY hX x_diff x_igFresh **
by (auto simp: igSubstCls_def igSubstIGAbs_def)
also have "… = ?Right" using Abs * by (auto simp: ipresCons_def ipresAbs_def)
finally show "?Left = ?Right" .
qed
qed
qed
lemma ipresCons_imp_ipresSubst:
assumes *: "ipresCons h hA MOD" and **: "igSubstCls MOD"
and "igConsIPresIGWls MOD" and "igFreshCls MOD"
shows "ipresSubst h MOD"
unfolding ipresSubst_def apply clarify
subgoal for ys Y y s X
using assms ipresCons_imp_ipresSubstAll_aux
[of h hA MOD
"ParS (λzs. if zs = ys then [y] else [])
(λs'. if s' = asSort ys then [Y] else [])
(λ_. [])
[]"]
unfolding wlsPar_def by auto .
lemma ipresCons_imp_ipresSubstAbs:
assumes *: "ipresCons h hA MOD" and **: "igSubstCls MOD"
and "igConsIPresIGWls MOD" and "igFreshCls MOD"
shows "ipresSubstAbs h hA MOD"
unfolding ipresSubstAbs_def apply clarify
subgoal for ys Y y us s A
using assms ipresCons_imp_ipresSubstAll_aux
[of h hA MOD
"ParS (λzs. if zs = ys then [y] else [])
(λs'. if s' = asSort ys then [Y] else [])
(λ_. [])
[]"]
unfolding wlsPar_def by auto .
lemma ipresCons_imp_ipresSubstAll:
assumes *: "ipresCons h hA MOD" and **: "igSubstCls MOD"
and "igConsIPresIGWls MOD" and "igFreshCls MOD"
shows "ipresSubstAll h hA MOD"
unfolding ipresSubstAll_def using assms
ipresCons_imp_ipresSubst ipresCons_imp_ipresSubstAbs by auto
lemma iwlsFSw_termFSwImorph_iff:
"iwlsFSw MOD ⟹ termFSwImorph h hA MOD = ipresCons h hA MOD"
unfolding iwlsFSw_def termFSwImorph_def
using ipresCons_imp_ipresWlsAll
ipresCons_imp_ipresFreshAll ipresCons_imp_ipresSwapAll by auto
corollary iwlsFSwSTR_termFSwImorph_iff:
"iwlsFSwSTR MOD ⟹ termFSwImorph h hA MOD = ipresCons h hA MOD"
using iwlsFSwSTR_imp_iwlsFSw iwlsFSw_termFSwImorph_iff by fastforce
lemma iwlsFSb_termFSbImorph_iff:
"iwlsFSb MOD ⟹ termFSbImorph h hA MOD = ipresCons h hA MOD"
unfolding iwlsFSb_def termFSbImorph_def
using ipresCons_imp_ipresWlsAll
ipresCons_imp_ipresFreshAll ipresCons_imp_ipresSubstAll
unfolding igSubstCls_def by fastforce+
corollary iwlsFSbSwTR_termFSbImorph_iff:
"iwlsFSbSwTR MOD ⟹ termFSbImorph h hA MOD = ipresCons h hA MOD"
using iwlsFSbSwTR_imp_iwlsFSb iwlsFSb_termFSbImorph_iff by fastforce
lemma iwlsFSwSb_termFSwSbImorph_iff:
"iwlsFSwSb MOD ⟹ termFSwSbImorph h hA MOD = ipresCons h hA MOD"
unfolding termFSwSbImorph_def iwlsFSwSb_def
apply(simp add: iwlsFSw_termFSwImorph_iff)
unfolding iwlsFSw_def using ipresCons_imp_ipresSubstAll by auto
lemma iwlsFSbSw_termFSwSbImorph_iff:
"iwlsFSbSw MOD ⟹ termFSwSbImorph h hA MOD = ipresCons h hA MOD"
unfolding termFSwSbImorph_iff iwlsFSbSw_def
apply(simp add: iwlsFSb_termFSbImorph_iff)
unfolding iwlsFSb_def using ipresCons_imp_ipresSwapAll by auto
end
subsection‹The ``error" model of associated to a model›
text‹The error model will have the operators act like the original ones
on well-formed terms, except that will return ``ERR" (error) or ``True" (in the case of fresh)
whenever one of the inputs (variables, terms or abstractions) is ``ERR" or
is not well-formed.
The error model is more convenient than the original one, since
one can define more easily a map from the model of terms to the former. This map shall be defined
by the universal property of quotients, via a map from quasi-terms whose kernel
includes the alpha-equivalence relation. The latter property (of including
the alpha-equivalence would not be achievable with the original model as tariget, since
alpha is defined unsortedly and the model clauses hold sortedly.
We shall only need error models associated to fresh-swap and to fresh-subst models.›
subsubsection ‹Preliminaries›
datatype 'a withERR = ERR | OK 'a
context FixSyn
begin
definition OKI where
"OKI inp = lift OK inp"
definition check where
"check eX == THE X. eX = OK X"
definition checkI where
"checkI einp == lift check einp"
lemma check_ex_unique:
"eX ≠ ERR ⟹ (EX! X. eX = OK X)"
by(cases eX, auto)
lemma check_OK[simp]:
"check (OK X) = X"
unfolding check_def using check_ex_unique theI' by auto
lemma OK_check[simp]:
"eX ≠ ERR ⟹ OK (check eX) = eX"
unfolding check_def using check_ex_unique theI' by auto
lemma checkI_OKI[simp]:
"checkI (OKI inp) = inp"
unfolding OKI_def checkI_def lift_def apply(rule ext)
by(case_tac "inp i", auto)
lemma OKI_checkI[simp]:
assumes "liftAll (λ X. X ≠ ERR) einp"
shows "OKI (checkI einp) = einp"
unfolding OKI_def checkI_def lift_def apply(rule ext)
using assms unfolding liftAll_def by (case_tac "einp i", auto)
lemma OKI_inj[simp]:
fixes inp inp' :: "('index,'gTerm)input"
shows "(OKI inp = OKI inp') = (inp = inp')"
apply(auto) unfolding OKI_def
using lift_preserves_inj[of OK]
unfolding inj_on_def by auto
lemmas OK_OKI_simps =
check_OK OK_check checkI_OKI OKI_checkI OKI_inj
subsubsection ‹Definitions and notations›
definition errMOD ::
"('index,'bindex,'varSort,'sort,'opSym,'var,'gTerm,'gAbs)model ⇒
('index,'bindex,'varSort,'sort,'opSym,'var,'gTerm withERR,'gAbs withERR)model"
where
"errMOD MOD ==
⦇igWls = λ s eX. case eX of ERR ⇒ False | OK X ⇒ igWls MOD s X,
igWlsAbs = λ (us,s) eA. case eA of ERR ⇒ False | OK A ⇒ igWlsAbs MOD (us,s) A,
igVar = λ xs x. OK (igVar MOD xs x),
igAbs = λxs x eX.
if (eX ≠ ERR ∧ (∃ s. isInBar (xs,s) ∧ igWls MOD s (check eX)))
then OK (igAbs MOD xs x (check eX))
else ERR,
igOp = λdelta einp ebinp.
if liftAll (λ X. X ≠ ERR) einp ∧ liftAll (λ A. A ≠ ERR) ebinp
∧ igWlsInp MOD delta (checkI einp) ∧ igWlsBinp MOD delta (checkI ebinp)
then OK (igOp MOD delta (checkI einp) (checkI ebinp))
else ERR,
igFresh = λys y eX.
if eX ≠ ERR ∧ (∃ s. igWls MOD s (check eX))
then igFresh MOD ys y (check eX)
else True,
igFreshAbs = λys y eA.
if eA ≠ ERR ∧ (∃ us s. igWlsAbs MOD (us,s) (check eA))
then igFreshAbs MOD ys y (check eA)
else True,
igSwap = λzs z1 z2 eX.
if eX ≠ ERR ∧ (∃ s. igWls MOD s (check eX))
then OK (igSwap MOD zs z1 z2 (check eX))
else ERR,
igSwapAbs = λzs z1 z2 eA.
if eA ≠ ERR ∧ (∃ us s. igWlsAbs MOD (us,s) (check eA))
then OK (igSwapAbs MOD zs z1 z2 (check eA))
else ERR,
igSubst = λys eY y eX.
if eY ≠ ERR ∧ igWls MOD (asSort ys) (check eY)
∧ eX ≠ ERR ∧ (∃ s. igWls MOD s (check eX))
then OK (igSubst MOD ys (check eY) y (check eX))
else ERR,
igSubstAbs = λys eY y eA.
if eY ≠ ERR ∧ igWls MOD (asSort ys) (check eY)
∧ eA ≠ ERR ∧ (∃ us s. igWlsAbs MOD (us,s) (check eA))
then OK (igSubstAbs MOD ys (check eY) y (check eA))
else ERR
⦈"
abbreviation eWls where "eWls MOD == igWls (errMOD MOD)"
abbreviation eWlsAbs where "eWlsAbs MOD == igWlsAbs (errMOD MOD)"
abbreviation eWlsInp where "eWlsInp MOD == igWlsInp (errMOD MOD)"
abbreviation eWlsBinp where "eWlsBinp MOD == igWlsBinp (errMOD MOD)"
abbreviation eVar where "eVar MOD == igVar (errMOD MOD)"
abbreviation eAbs where "eAbs MOD == igAbs (errMOD MOD)"
abbreviation eOp where "eOp MOD == igOp (errMOD MOD)"
abbreviation eFresh where "eFresh MOD == igFresh (errMOD MOD)"
abbreviation eFreshAbs where "eFreshAbs MOD == igFreshAbs (errMOD MOD)"
abbreviation eFreshInp where "eFreshInp MOD == igFreshInp (errMOD MOD)"
abbreviation eFreshBinp where "eFreshBinp MOD == igFreshBinp (errMOD MOD)"
abbreviation eSwap where "eSwap MOD == igSwap (errMOD MOD)"
abbreviation eSwapAbs where "eSwapAbs MOD == igSwapAbs (errMOD MOD)"
abbreviation eSwapInp where "eSwapInp MOD == igSwapInp (errMOD MOD)"
abbreviation eSwapBinp where "eSwapBinp MOD == igSwapBinp (errMOD MOD)"
abbreviation eSubst where "eSubst MOD == igSubst (errMOD MOD)"
abbreviation eSubstAbs where "eSubstAbs MOD == igSubstAbs (errMOD MOD)"
abbreviation eSubstInp where "eSubstInp MOD == igSubstInp (errMOD MOD)"
abbreviation eSubstBinp where "eSubstBinp MOD == igSubstBinp (errMOD MOD)"
subsubsection ‹Simplification rules›
lemma eWls_simp1[simp]:
"eWls MOD s (OK X) = igWls MOD s X"
unfolding errMOD_def by simp
lemma eWls_simp2[simp]:
"eWls MOD s ERR = False"
unfolding errMOD_def by simp
lemma eWlsAbs_simp1[simp]:
"eWlsAbs MOD (us,s) (OK A) = igWlsAbs MOD (us,s) A"
unfolding errMOD_def by simp
lemma eWlsAbs_simp2[simp]:
"eWlsAbs MOD (us,s) ERR = False"
unfolding errMOD_def by simp
lemma eWlsInp_simp1[simp]:
"eWlsInp MOD delta (OKI inp) = igWlsInp MOD delta inp"
by (fastforce simp: OKI_def sameDom_def liftAll2_def lift_def igWlsInp_def
split: option.splits)
lemma eWlsInp_simp2[simp]:
"¬ liftAll (λ eX. eX ≠ ERR) einp ⟹ ¬ eWlsInp MOD delta einp"
by (force simp: sameDom_def liftAll_def liftAll2_def lift_def igWlsInp_def)
corollary eWlsInp_simp3[simp]:
"¬ eWlsInp MOD delta (λi. Some ERR)"
by (auto simp: liftAll_def)
lemma eWlsBinp_simp1[simp]:
"eWlsBinp MOD delta (OKI binp) = igWlsBinp MOD delta binp"
by (fastforce simp: OKI_def sameDom_def liftAll2_def lift_def igWlsBinp_def
split: option.splits)
lemma eWlsBinp_simp2[simp]:
"¬ liftAll (λ eA. eA ≠ ERR) ebinp ⟹ ¬ eWlsBinp MOD delta ebinp"
by (force simp: sameDom_def liftAll_def liftAll2_def lift_def igWlsBinp_def)
corollary eWlsBinp_simp3[simp]:
"¬ eWlsBinp MOD delta (λi. Some ERR)"
by (auto simp: liftAll_def)
lemmas eWlsAll_simps =
eWls_simp1 eWls_simp2
eWlsAbs_simp1 eWlsAbs_simp2
eWlsInp_simp1 eWlsInp_simp2 eWlsInp_simp3
eWlsBinp_simp1 eWlsBinp_simp2 eWlsBinp_simp3
lemma eVar_simp[simp]:
"eVar MOD xs x = OK (igVar MOD xs x)"
unfolding errMOD_def by simp
lemma eAbs_simp1[simp]:
"⟦isInBar (xs,s); igWls MOD s X⟧ ⟹ eAbs MOD xs x (OK X) = OK (igAbs MOD xs x X)"
unfolding errMOD_def by auto
lemma eAbs_simp2[simp]:
"∀ s. ¬ (isInBar (xs,s) ∧ igWls MOD s X) ⟹ eAbs MOD xs x (OK X) = ERR"
unfolding errMOD_def by auto
lemma eAbs_simp3[simp]:
"eAbs MOD xs x ERR = ERR"
unfolding errMOD_def by auto
lemma eOp_simp1[simp]:
assumes "igWlsInp MOD delta inp" and "igWlsBinp MOD delta binp"
shows "eOp MOD delta (OKI inp) (OKI binp) = OK (igOp MOD delta inp binp)"
unfolding errMOD_def apply simp
unfolding liftAll_def OKI_def lift_def
using assms by (auto split: option.splits)
lemma eOp_simp2[simp]:
assumes "¬ igWlsInp MOD delta inp"
shows "eOp MOD delta (OKI inp) ebinp = ERR"
using assms unfolding errMOD_def by auto
lemma eOp_simp3[simp]:
assumes "¬ igWlsBinp MOD delta binp"
shows "eOp MOD delta einp (OKI binp) = ERR"
using assms unfolding errMOD_def by auto
lemma eOp_simp4[simp]:
assumes "¬ liftAll (λ eX. eX ≠ ERR) einp"
shows "eOp MOD delta einp ebinp = ERR"
using assms unfolding errMOD_def by auto
corollary eOp_simp5[simp]:
"eOp MOD delta (λi. Some ERR) ebinp = ERR"
by (auto simp: liftAll_def)
lemma eOp_simp6[simp]:
assumes "¬ liftAll (λ eA. eA ≠ ERR) ebinp"
shows "eOp MOD delta einp ebinp = ERR"
using assms unfolding errMOD_def by auto
corollary eOp_simp7[simp]:
"eOp MOD delta einp (λi. Some ERR) = ERR"
by (auto simp: liftAll_def)
lemmas eCons_simps =
eVar_simp
eAbs_simp1 eAbs_simp2 eAbs_simp3
eOp_simp1 eOp_simp2 eOp_simp3 eOp_simp4 eOp_simp5 eOp_simp6 eOp_simp7
lemma eFresh_simp1[simp]:
"igWls MOD s X ⟹ eFresh MOD ys y (OK X) = igFresh MOD ys y X"
unfolding errMOD_def by auto
lemma eFresh_simp2[simp]:
"∀ s. ¬ igWls MOD s X ⟹ eFresh MOD ys y (OK X)"
unfolding errMOD_def by auto
lemma eFresh_simp3[simp]:
"eFresh MOD ys y ERR"
unfolding errMOD_def by auto
lemma eFreshAbs_simp1[simp]:
"igWlsAbs MOD (us,s) A ⟹ eFreshAbs MOD ys y (OK A) = igFreshAbs MOD ys y A"
unfolding errMOD_def by auto
lemma eFreshAbs_simp2[simp]:
"∀ us s. ¬ igWlsAbs MOD (us,s) A ⟹ eFreshAbs MOD ys y (OK A)"
unfolding errMOD_def by auto
lemma eFreshAbs_simp3[simp]:
"eFreshAbs MOD ys y ERR"
unfolding errMOD_def by auto
lemma eFreshInp_simp[simp]:
"igWlsInp MOD delta inp
⟹ eFreshInp MOD ys y (OKI inp) = igFreshInp MOD ys y inp"
by (force simp: igFreshInp_def OKI_def liftAll_lift_comp igWlsInp_defs intro!: liftAll_cong)
lemma eFreshBinp_simp[simp]:
"igWlsBinp MOD delta binp
⟹ eFreshBinp MOD ys y (OKI binp) = igFreshBinp MOD ys y binp"
by (force simp: igFreshBinp_def OKI_def liftAll_lift_comp igWlsBinp_defs intro!: liftAll_cong)
lemmas eFreshAll_simps =
eFresh_simp1 eFresh_simp2 eFresh_simp3
eFreshAbs_simp1 eFreshAbs_simp2 eFreshAbs_simp3
eFreshInp_simp
eFreshBinp_simp
lemma eSwap_simp1[simp]:
"igWls MOD s X
⟹ eSwap MOD zs z1 z2 (OK X) = OK (igSwap MOD zs z1 z2 X)"
unfolding errMOD_def by auto
lemma eSwap_simp2[simp]:
"∀ s. ¬ igWls MOD s X ⟹ eSwap MOD zs z1 z2 (OK X) = ERR"
unfolding errMOD_def by auto
lemma eSwap_simp3[simp]:
"eSwap MOD zs z1 z2 ERR = ERR"
unfolding errMOD_def by auto
lemma eSwapAbs_simp1[simp]:
"igWlsAbs MOD (us,s) A
⟹ eSwapAbs MOD zs z1 z2 (OK A) = OK (igSwapAbs MOD zs z1 z2 A)"
unfolding errMOD_def by auto
lemma eSwapAbs_simp2[simp]:
"∀ us s. ¬ igWlsAbs MOD (us,s) A ⟹ eSwapAbs MOD zs z1 z2 (OK A) = ERR"
unfolding errMOD_def by auto
lemma eSwapAbs_simp3[simp]:
"eSwapAbs MOD zs z1 z2 ERR = ERR"
unfolding errMOD_def by auto
lemma eSwapInp_simp1[simp]:
"igWlsInp MOD delta inp
⟹ eSwapInp MOD zs z1 z2 (OKI inp) = OKI (igSwapInp MOD zs z1 z2 inp)"
by (force simp: igSwapInp_def OKI_def lift_comp igWlsInp_defs intro!: lift_cong)
lemma eSwapInp_simp2[simp]:
assumes "¬ liftAll (λ eX. eX ≠ ERR) einp"
shows "¬ liftAll (λ eX. eX ≠ ERR) (eSwapInp MOD zs z1 z2 einp)"
using assms unfolding liftAll_def igSwapInp_def lift_def by (auto split: option.splits)
lemma eSwapBinp_simp1[simp]:
"igWlsBinp MOD delta binp
⟹ eSwapBinp MOD zs z1 z2 (OKI binp) = OKI (igSwapBinp MOD zs z1 z2 binp)"
by (force simp: igSwapBinp_def OKI_def lift_comp igWlsBinp_defs intro!: lift_cong)
lemma eSwapBinp_simp2[simp]:
assumes "¬ liftAll (λ eA. eA ≠ ERR) ebinp"
shows "¬ liftAll (λ eA. eA ≠ ERR) (eSwapBinp MOD zs z1 z2 ebinp)"
using assms unfolding liftAll_def igSwapBinp_def lift_def by (auto split: option.splits)
lemmas eSwapAll_simps =
eSwap_simp1 eSwap_simp2 eSwap_simp3
eSwapAbs_simp1 eSwapAbs_simp2 eSwapAbs_simp3
eSwapInp_simp1 eSwapInp_simp2
eSwapBinp_simp1 eSwapBinp_simp2
lemma eSubst_simp1[simp]:
"⟦igWls MOD (asSort ys) Y; igWls MOD s X⟧
⟹ eSubst MOD ys (OK Y) y (OK X) = OK (igSubst MOD ys Y y X)"
unfolding errMOD_def by auto
lemma eSubst_simp2[simp]:
"¬ igWls MOD (asSort ys) Y ⟹ eSubst MOD ys (OK Y) y eX = ERR"
unfolding errMOD_def by auto
lemma eSubst_simp3[simp]:
"∀ s. ¬ igWls MOD s X ⟹ eSubst MOD ys eY y (OK X) = ERR"
unfolding errMOD_def by auto
lemma eSubst_simp4[simp]:
"eSubst MOD ys eY y ERR = ERR"
unfolding errMOD_def by auto
lemma eSubst_simp5[simp]:
"eSubst MOD ys ERR y eX = ERR"
unfolding errMOD_def by auto
lemma eSubstAbs_simp1[simp]:
"⟦igWls MOD (asSort ys) Y; igWlsAbs MOD (us,s) A⟧
⟹ eSubstAbs MOD ys (OK Y) y (OK A) = OK (igSubstAbs MOD ys Y y A)"
unfolding errMOD_def by auto
lemma eSubstAbs_simp2[simp]:
"¬ igWls MOD (asSort ys) Y ⟹ eSubstAbs MOD ys (OK Y) y eA = ERR"
unfolding errMOD_def by auto
lemma eSubstAbs_simp3[simp]:
"∀ us s. ¬ igWlsAbs MOD (us,s) A ⟹ eSubstAbs MOD ys eY y (OK A) = ERR"
unfolding errMOD_def by auto
lemma eSubstAbs_simp4[simp]:
"eSubstAbs MOD ys eY y ERR = ERR"
unfolding errMOD_def by auto
lemma eSubstAbs_simp5[simp]:
"eSubstAbs MOD ys ERR y eA = ERR"
unfolding errMOD_def by auto
lemma eSubstInp_simp1[simp]:
"⟦igWls MOD (asSort ys) Y; igWlsInp MOD delta inp⟧
⟹ eSubstInp MOD ys (OK Y) y (OKI inp) = OKI (igSubstInp MOD ys Y y inp)"
by (force simp: igSubstInp_def OKI_def lift_comp igWlsInp_defs intro!: lift_cong)
lemma eSubstInp_simp2[simp]:
assumes "¬ liftAll (λeX. eX ≠ ERR) einp"
shows "¬ liftAll (λeX. eX ≠ ERR) (eSubstInp MOD ys eY y einp)"
using assms unfolding lift_def igSubstInp_def liftAll_def by (auto split: option.splits)
lemma eSubstInp_simp3[simp]:
assumes *: "¬ igWls MOD (asSort ys) Y" and **: "¬ einp = (λ i. None)"
shows "¬ liftAll (λeX. eX ≠ ERR) (eSubstInp MOD ys (OK Y) y einp)"
using assms by (auto simp: igSubstInp_def liftAll_lift_comp lift_def liftAll_def
split: option.splits)
lemma eSubstInp_simp4[simp]:
assumes "¬ einp = (λ i. None)"
shows "¬ liftAll (λeX. eX ≠ ERR) (eSubstInp MOD ys ERR y einp)"
using assms by (auto simp: igSubstInp_def liftAll_lift_comp lift_def liftAll_def
split: option.splits)
lemma eSubstBinp_simp1[simp]:
"⟦igWls MOD (asSort ys) Y; igWlsBinp MOD delta binp⟧
⟹ eSubstBinp MOD ys (OK Y) y (OKI binp) = OKI (igSubstBinp MOD ys Y y binp)"
by (force simp: igSubstBinp_def OKI_def lift_comp igWlsBinp_defs intro!: lift_cong)
lemma eSubstBinp_simp2[simp]:
assumes "¬ liftAll (λeA. eA ≠ ERR) ebinp"
shows "¬ liftAll (λeA. eA ≠ ERR) (eSubstBinp MOD ys eY y ebinp)"
using assms by (auto simp: igSubstBinp_def liftAll_lift_comp lift_def liftAll_def
split: option.splits)
lemma eSubstBinp_simp3[simp]:
assumes *: "¬ igWls MOD (asSort ys) Y" and **: "¬ ebinp = (λ i. None)"
shows "¬ liftAll (λeA. eA ≠ ERR) (eSubstBinp MOD ys (OK Y) y ebinp)"
using assms by (auto simp: igSubstBinp_def liftAll_lift_comp lift_def liftAll_def
split: option.splits)
lemma eSubstBinp_simp4[simp]:
assumes "¬ ebinp = (λ i. None)"
shows "¬ liftAll (λeA. eA ≠ ERR) (eSubstBinp MOD ys ERR y ebinp)"
using assms by (auto simp: igSubstBinp_def liftAll_lift_comp lift_def liftAll_def
split: option.splits)
lemmas eSubstAll_simps =
eSubst_simp1 eSubst_simp2 eSubst_simp3 eSubst_simp4 eSubst_simp5
eSubstAbs_simp1 eSubstAbs_simp2 eSubstAbs_simp3 eSubstAbs_simp4 eSubstAbs_simp5
eSubstInp_simp1 eSubstInp_simp2 eSubstInp_simp3 eSubstInp_simp4
eSubstBinp_simp1 eSubstBinp_simp2 eSubstBinp_simp3 eSubstBinp_simp4
lemmas error_model_simps =
OK_OKI_simps
eWlsAll_simps
eCons_simps
eFreshAll_simps
eSwapAll_simps
eSubstAll_simps
subsubsection ‹Nchotomies›
lemma eWls_nchotomy:
"(∃ X. eX = OK X ∧ igWls MOD s X) ∨ ¬ eWls MOD s eX"
unfolding errMOD_def by(cases eX) auto
lemma eWlsAbs_nchotomy:
"(∃ A. eA = OK A ∧ igWlsAbs MOD (us,s) A) ∨ ¬ eWlsAbs MOD (us,s) eA"
unfolding errMOD_def by(cases eA) auto
lemma eAbs_nchotomy:
"((∃ s X. eX = OK X ∧ isInBar (xs,s) ∧ igWls MOD s X)) ∨ (eAbs MOD xs x eX = ERR)"
unfolding errMOD_def apply simp using OK_check by fastforce
lemma eOp_nchotomy:
"(∃ inp binp. einp = OKI inp ∧ igWlsInp MOD delta inp ∧
ebinp = OKI binp ∧ igWlsBinp MOD delta binp)
∨
(eOp MOD delta einp ebinp = ERR)"
unfolding errMOD_def apply simp using OKI_checkI by force
lemma eFresh_nchotomy:
"(∃ s X. eX = OK X ∧ igWls MOD s X) ∨ eFresh MOD ys y eX"
unfolding errMOD_def apply simp using OK_check by fastforce
lemma eFreshAbs_nchotomy:
"(∃ us s A. eA = OK A ∧ igWlsAbs MOD (us,s) A)
∨ eFreshAbs MOD ys y eA"
unfolding errMOD_def apply simp using OK_check by fastforce
lemma eSwap_nchotomy:
"(∃ s X. eX = OK X ∧ igWls MOD s X) ∨
(eSwap MOD zs z1 z2 eX = ERR)"
unfolding errMOD_def apply simp using OK_check by fastforce
lemma eSwapAbs_nchotomy:
"(∃ us s A. eA = OK A ∧ igWlsAbs MOD (us,s) A) ∨
(eSwapAbs MOD zs z1 z2 eA = ERR)"
unfolding errMOD_def apply simp using OK_check by fastforce
lemma eSubst_nchotomy:
"(∃ Y. eY = OK Y ∧
igWls MOD (asSort ys) Y) ∧ (∃ s X. eX = OK X ∧ igWls MOD s X)
∨
(eSubst MOD ys eY y eX = ERR)"
unfolding errMOD_def apply simp using OK_check by fastforce
lemma eSubstAbs_nchotomy:
"(∃ Y. eY = OK Y ∧ igWls MOD (asSort ys) Y) ∧
(∃ us s A. eA = OK A ∧ igWlsAbs MOD (us,s) A)
∨
(eSubstAbs MOD ys eY y eA = ERR)"
unfolding errMOD_def apply simp using OK_check by fastforce
subsubsection ‹Inversion rules›
lemma eWls_invert:
assumes "eWls MOD s eX"
shows "∃ X. eX = OK X ∧ igWls MOD s X"
using assms eWls_nchotomy by blast
lemma eWlsAbs_invert:
assumes "eWlsAbs MOD (us,s) eA"
shows "∃ A. eA = OK A ∧ igWlsAbs MOD (us,s) A"
using assms eWlsAbs_nchotomy by blast
lemma eWlsInp_invert:
assumes "eWlsInp MOD delta einp"
shows "∃ inp. igWlsInp MOD delta inp ∧ einp = OKI inp"
proof
let ?inp = "checkI einp"
have "wlsOpS delta" using assms unfolding igWlsInp_def by simp
moreover have "sameDom (arOf delta) ?inp"
using assms unfolding igWlsInp_def checkI_def by simp
moreover have "liftAll2 (igWls MOD) (arOf delta) ?inp"
using assms eWls_invert
by (fastforce simp: igWlsInp_def checkI_def liftAll2_def lift_def sameDom_def
split: option.splits)
ultimately have "igWlsInp MOD delta ?inp" unfolding igWlsInp_def by simp
moreover
{have "liftAll (λeX. eX ≠ ERR) einp"
using assms using eWlsInp_simp2 by blast
hence "einp = OKI ?inp" by simp
}
ultimately show "igWlsInp MOD delta ?inp ∧ einp = OKI ?inp" by simp
qed
lemma eWlsBinp_invert:
assumes "eWlsBinp MOD delta ebinp"
shows "∃ binp. igWlsBinp MOD delta binp ∧ ebinp = OKI binp"
proof
let ?binp = "checkI ebinp"
have "wlsOpS delta" using assms unfolding igWlsBinp_def by simp
moreover have "sameDom (barOf delta) ?binp"
using assms unfolding igWlsBinp_def checkI_def by simp
moreover have "liftAll2 (igWlsAbs MOD) (barOf delta) ?binp"
using assms eWlsAbs_invert
by (fastforce simp: igWlsBinp_def checkI_def liftAll2_def lift_def sameDom_def
split: option.splits)
ultimately have "igWlsBinp MOD delta ?binp" unfolding igWlsBinp_def by simp
moreover
{have "liftAll (λeA. eA ≠ ERR) ebinp"
using assms using eWlsBinp_simp2 by blast
hence "ebinp = OKI ?binp" by simp
}
ultimately show "igWlsBinp MOD delta ?binp ∧ ebinp = OKI ?binp" by simp
qed
lemma eAbs_invert:
assumes "eAbs MOD xs x eX = OK A"
shows "∃ s X. eX = OK X ∧ isInBar (xs,s) ∧ A = igAbs MOD xs x X ∧ igWls MOD s X"
proof-
have 1: "eAbs MOD xs x eX ≠ ERR" using assms by auto
then obtain s X where *: "eX = OK X"
and **: "isInBar (xs,s)" and ***: "igWls MOD s X"
using eAbs_nchotomy[of eX] by fastforce
hence "eAbs MOD xs x eX = OK (igAbs MOD xs x X)" by simp
thus ?thesis using assms * ** *** by auto
qed
lemma eOp_invert:
assumes "eOp MOD delta einp ebinp = OK X"
shows
"∃ inp binp. einp = OKI inp ∧ ebinp = OKI binp ∧
X = igOp MOD delta inp binp ∧
igWlsInp MOD delta inp ∧ igWlsBinp MOD delta binp"
proof-
have "eOp MOD delta einp ebinp ≠ ERR" using assms by auto
then obtain inp binp where *: "einp = OKI inp" "ebinp = OKI binp"
"igWlsInp MOD delta inp" "igWlsBinp MOD delta binp"
using eOp_nchotomy by blast
hence "eOp MOD delta einp ebinp = OK (igOp MOD delta inp binp)" by simp
thus ?thesis using assms * by auto
qed
lemma eFresh_invert:
assumes "¬ eFresh MOD ys y eX"
shows "∃ s X. eX = OK X ∧ ¬ igFresh MOD ys y X ∧ igWls MOD s X"
proof-
obtain s X where *: "eX = OK X" and **: "igWls MOD s X"
using assms eFresh_nchotomy[of eX] by fastforce
hence "eFresh MOD ys y eX = igFresh MOD ys y X" by simp
thus ?thesis using assms * ** by auto
qed
lemma eFreshAbs_invert:
assumes "¬ eFreshAbs MOD ys y eA"
shows "∃ us s A. eA = OK A ∧ ¬ igFreshAbs MOD ys y A ∧ igWlsAbs MOD (us,s) A"
proof-
obtain us s A where *: "eA = OK A" and **: "igWlsAbs MOD (us,s) A"
using assms eFreshAbs_nchotomy[of eA] by fastforce
hence "eFreshAbs MOD ys y eA = igFreshAbs MOD ys y A" by simp
thus ?thesis using assms * ** by auto
qed
lemma eSwap_invert:
assumes "eSwap MOD zs z1 z2 eX = OK Y"
shows "∃ s X. eX = OK X ∧ Y = igSwap MOD zs z1 z2 X ∧ igWls MOD s X"
proof-
have 1: "eSwap MOD zs z1 z2 eX ≠ ERR" using assms by auto
then obtain s X where *: "eX = OK X" and **: "igWls MOD s X"
using eSwap_nchotomy[of eX] by fastforce
hence "eSwap MOD zs z1 z2 eX = OK (igSwap MOD zs z1 z2 X)" by simp
thus ?thesis using assms * ** by auto
qed
lemma eSwapAbs_invert:
assumes "eSwapAbs MOD zs z1 z2 eA = OK B"
shows "∃ us s A. eA = OK A ∧ B = igSwapAbs MOD zs z1 z2 A ∧ igWlsAbs MOD (us,s) A"
proof-
have 1: "eSwapAbs MOD zs z1 z2 eA ≠ ERR" using assms by auto
then obtain us s A where *: "eA = OK A" and **: "igWlsAbs MOD (us,s) A"
using eSwapAbs_nchotomy[of eA] by fastforce
hence "eSwapAbs MOD zs z1 z2 eA = OK (igSwapAbs MOD zs z1 z2 A)" by simp
thus ?thesis using assms * ** by auto
qed
lemma eSubst_invert:
assumes "eSubst MOD ys eY y eX = OK Z"
shows
"∃ s X Y. eY = OK Y ∧ eX = OK X ∧ igWls MOD s X ∧ igWls MOD (asSort ys) Y ∧
Z = igSubst MOD ys Y y X"
proof-
have 1: "eSubst MOD ys eY y eX ≠ ERR" using assms by auto
then obtain s X Y where *: "eX = OK X" "eY = OK Y"
"igWls MOD s X" "igWls MOD (asSort ys) Y"
using eSubst_nchotomy[of eY _ _ eX] by fastforce
hence "eSubst MOD ys eY y eX = OK (igSubst MOD ys Y y X)" by simp
thus ?thesis using assms * by auto
qed
lemma eSubstAbs_invert:
assumes "eSubstAbs MOD ys eY y eA = OK Z"
shows
"∃ us s A Y. eY = OK Y ∧ eA = OK A ∧ igWlsAbs MOD (us,s) A ∧ igWls MOD (asSort ys) Y ∧
Z = igSubstAbs MOD ys Y y A"
proof-
have 1: "eSubstAbs MOD ys eY y eA ≠ ERR" using assms by auto
then obtain us s A Y where *: "eA = OK A" "eY = OK Y"
"igWlsAbs MOD (us,s) A" "igWls MOD (asSort ys) Y"
using eSubstAbs_nchotomy[of eY _ _ eA] by fastforce
hence "eSubstAbs MOD ys eY y eA = OK (igSubstAbs MOD ys Y y A)" by simp
thus ?thesis using assms * by auto
qed
subsubsection ‹The error model is strongly well-sorted
as a fresh-swap-subst and as a fresh-subst-swap model›
text‹That is, provided the original model is a well-sorted fresh-swap model.›
text‹The domains are disjoint:›
lemma errMOD_igWlsDisj:
assumes "igWlsDisj MOD"
shows "igWlsDisj (errMOD MOD)"
using assms unfolding errMOD_def igWlsDisj_def
apply clarify subgoal for _ _ X by(cases X) auto .
lemma errMOD_igWlsAbsDisj:
assumes "igWlsAbsDisj MOD"
shows "igWlsAbsDisj (errMOD MOD)"
using assms unfolding errMOD_def igWlsAbsDisj_def
apply clarify subgoal for _ _ _ _ A by(cases A) fastforce+ .
lemma errMOD_igWlsAllDisj:
assumes "igWlsAllDisj MOD"
shows "igWlsAllDisj (errMOD MOD)"
using assms unfolding igWlsAllDisj_def
using errMOD_igWlsDisj errMOD_igWlsAbsDisj by auto
text‹Only ``bound arity" abstraction domains are inhabited:›
lemma errMOD_igWlsAbsIsInBar:
assumes "igWlsAbsIsInBar MOD"
shows "igWlsAbsIsInBar (errMOD MOD)"
using assms eWlsAbs_invert unfolding igWlsAbsIsInBar_def by blast
text‹The operators preserve the domains strongly:›
lemma errMOD_igVarIPresIGWlsSTR:
assumes "igVarIPresIGWls MOD"
shows "igVarIPresIGWls (errMOD MOD)"
using assms unfolding errMOD_def igVarIPresIGWls_def by simp
lemma errMOD_igAbsIPresIGWlsSTR:
assumes *: "igAbsIPresIGWls MOD" and **: "igWlsAbsDisj MOD"
and ***: "igWlsAbsIsInBar MOD"
shows "igAbsIPresIGWlsSTR (errMOD MOD)"
using assms by (fastforce simp: errMOD_def igAbsIPresIGWls_def igAbsIPresIGWlsSTR_def
igWlsAbsIsInBar_def igWlsAbsDisj_def split: withERR.splits)
lemma errMOD_igOpIPresIGWlsSTR:
fixes MOD :: "('index,'bindex,'varSort,'sort,'opSym,'var,'gTerm,'gAbs)model"
assumes "igOpIPresIGWls MOD"
shows "igOpIPresIGWlsSTR (errMOD MOD)"
by (simp add: igOpIPresIGWlsSTR_def igOpIPresIGWls_def)
(smt assms eOp_nchotomy eOp_simp1 eWlsBinp_invert
eWlsBinp_simp1 eWlsInp_invert eWlsInp_simp1 eWls_simp1 eWls_simp2 igOpIPresIGWls_def)
lemma errMOD_igConsIPresIGWlsSTR:
assumes "igConsIPresIGWls MOD" and "igWlsAllDisj MOD"
and "igWlsAbsIsInBar MOD"
shows "igConsIPresIGWlsSTR (errMOD MOD)"
using assms unfolding igConsIPresIGWls_def igConsIPresIGWlsSTR_def igWlsAllDisj_def
using
errMOD_igVarIPresIGWlsSTR[of MOD]
errMOD_igAbsIPresIGWlsSTR[of MOD]
errMOD_igOpIPresIGWlsSTR[of MOD]
by auto
lemma errMOD_igSwapIPresIGWlsSTR:
assumes "igSwapIPresIGWls MOD" and "igWlsDisj MOD"
shows "igSwapIPresIGWlsSTR (errMOD MOD)"
using ‹igSwapIPresIGWls MOD›
using assms by (fastforce simp: errMOD_def igSwapIPresIGWls_def igSwapIPresIGWlsSTR_def
igWlsDisj_def split: withERR.splits)
lemma errMOD_igSwapAbsIPresIGWlsAbsSTR:
assumes *: "igSwapAbsIPresIGWlsAbs MOD" and **: "igWlsAbsDisj MOD"
and ***: "igWlsAbsIsInBar MOD"
shows "igSwapAbsIPresIGWlsAbsSTR (errMOD MOD)"
using assms by (simp add: errMOD_def igSwapAbsIPresIGWlsAbs_def igSwapAbsIPresIGWlsAbsSTR_def
igWlsAbsIsInBar_def igWlsAbsDisj_def split: withERR.splits) blast
lemma errMOD_igSwapAllIPresIGWlsAllSTR:
assumes "igSwapAllIPresIGWlsAll MOD" and "igWlsAllDisj MOD"
and "igWlsAbsIsInBar MOD"
shows "igSwapAllIPresIGWlsAllSTR (errMOD MOD)"
using assms
unfolding igSwapAllIPresIGWlsAll_def igSwapAllIPresIGWlsAllSTR_def igWlsAllDisj_def
using errMOD_igSwapIPresIGWlsSTR[of MOD] errMOD_igSwapIPresIGWlsSTR[of MOD]
errMOD_igSwapAbsIPresIGWlsAbsSTR[of MOD]
by auto
lemma errMOD_igSubstIPresIGWlsSTR:
assumes "igSubstIPresIGWls MOD" and "igWlsDisj MOD"
shows "igSubstIPresIGWlsSTR (errMOD MOD)"
using ‹igSubstIPresIGWls MOD›
using assms by (fastforce simp: errMOD_def igSubstIPresIGWls_def igSubstIPresIGWlsSTR_def
igWlsDisj_def split: withERR.splits)
lemma errMOD_igSubstAbsIPresIGWlsAbsSTR:
assumes *: "igSubstAbsIPresIGWlsAbs MOD" and **: "igWlsAbsDisj MOD"
and ***: "igWlsAbsIsInBar MOD"
shows "igSubstAbsIPresIGWlsAbsSTR (errMOD MOD)"
using assms by (simp add: errMOD_def igSubstAbsIPresIGWlsAbs_def igSubstAbsIPresIGWlsAbsSTR_def
igWlsAbsIsInBar_def igWlsAbsDisj_def split: withERR.splits) blast
lemma errMOD_igSubstAllIPresIGWlsAllSTR:
assumes "igSubstAllIPresIGWlsAll MOD" and "igWlsAllDisj MOD"
and "igWlsAbsIsInBar MOD"
shows "igSubstAllIPresIGWlsAllSTR (errMOD MOD)"
using assms
unfolding igSubstAllIPresIGWlsAll_def igSubstAllIPresIGWlsAllSTR_def igWlsAllDisj_def
using errMOD_igSubstIPresIGWlsSTR[of MOD] errMOD_igSubstIPresIGWlsSTR[of MOD]
errMOD_igSubstAbsIPresIGWlsAbsSTR[of MOD]
by auto
text‹The strong ``fresh" clauses are satisfied:›
lemma errMOD_igFreshIGVarSTR:
assumes "igVarIPresIGWls MOD" and "igFreshIGVar MOD"
shows "igFreshIGVar (errMOD MOD)"
using assms eFresh_simp1
by(fastforce simp: igVarIPresIGWls_def igFreshIGVar_def)
lemma errMOD_igFreshIGAbs1STR:
assumes *: "igAbsIPresIGWls MOD" and **: "igFreshIGAbs1 MOD"
shows "igFreshIGAbs1STR (errMOD MOD)"
unfolding igFreshIGAbs1STR_def proof(clarify)
fix ys y eX
show "eFreshAbs MOD ys y (eAbs MOD ys y eX)"
proof(cases "eX ≠ ERR")
define X where "X ≡ check eX"
case True
hence eX: "eX = OK X" unfolding X_def using OK_check by auto
show ?thesis using assms eFreshAbs_simp1 unfolding eX
by (cases "∃ s. isInBar (ys,s) ∧ igWls MOD s X")
(fastforce simp: igAbsIPresIGWls_def igFreshIGAbs1_def)+
qed auto
qed
lemma errMOD_igFreshIGAbs2STR:
assumes "igAbsIPresIGWls MOD" and "igFreshIGAbs2 MOD"
shows "igFreshIGAbs2STR (errMOD MOD)"
unfolding igFreshIGAbs2STR_def proof(clarify)
fix ys y xs x eX
assume *: "eFresh MOD ys y eX"
define X where "X ≡ check eX"
show "eFreshAbs MOD ys y (eAbs MOD xs x eX)"
proof(cases "eX ≠ ERR")
case True
hence eX: "eX = OK X" unfolding X_def using OK_check by auto
show ?thesis unfolding eX
using assms * eFreshAbs_invert eX
by (cases "∃ s. isInBar (xs,s) ∧ igWls MOD s X")
(fastforce simp: igAbsIPresIGWls_def igFreshIGAbs2_def)+
qed auto
qed
lemma errMOD_igFreshIGOpSTR:
fixes MOD :: "('index,'bindex,'varSort,'sort,'opSym,'var,'gTerm,'gAbs)model"
assumes "igOpIPresIGWls MOD" and "igFreshIGOp MOD"
shows "igFreshIGOpSTR (errMOD MOD)"
unfolding igFreshIGOpSTR_def apply clarify
subgoal for ys y delta einp ebinp
apply(cases "liftAll (λeX. eX ≠ ERR) einp ∧
liftAll (λeA. eA ≠ ERR) ebinp")
using assms by (simp_all add: igOpIPresIGWls_def igFreshIGOp_def)
(metis eFreshBinp_simp eFreshInp_simp eFresh_invert eOp_invert)+ .
lemma errMOD_igFreshClsSTR:
assumes "igConsIPresIGWls MOD" and "igFreshCls MOD"
shows "igFreshClsSTR (errMOD MOD)"
using assms unfolding igConsIPresIGWls_def igFreshCls_def igFreshClsSTR_def
using
errMOD_igFreshIGVarSTR
errMOD_igFreshIGAbs1STR errMOD_igFreshIGAbs2STR
errMOD_igFreshIGOpSTR
by auto
text‹The strong ``swap" clauses are satisfied:›
lemma errMOD_igSwapIGVarSTR:
fixes MOD :: "('index,'bindex,'varSort,'sort,'opSym,'var,'gTerm,'gAbs)model"
assumes "igVarIPresIGWls MOD" and "igSwapIGVar MOD"
shows "igSwapIGVar (errMOD MOD)"
using assms by (simp add: igVarIPresIGWls_def igSwapIGVar_def) (metis eSwap_simp1)
lemma errMOD_igSwapIGAbsSTR:
assumes *: "igAbsIPresIGWls MOD" and **: "igWlsDisj MOD"
and ***: "igSwapIPresIGWls MOD" and ****: "igSwapIGAbs MOD"
shows "igSwapIGAbsSTR (errMOD MOD)"
unfolding igSwapIGAbsSTR_def apply(clarify)
subgoal for zs z1 z2 xs x eX
apply (cases eX)
subgoal by auto
subgoal for X
apply(cases "∃ s. isInBar (xs,s) ∧ igWls MOD s X")
subgoal using assms
using assms OK_check
by (simp_all add: igAbsIPresIGWls_def igSwapIPresIGWls_def igSwapIGAbs_def igWlsDisj_def)
(smt eAbs_simp1 eSwapAbs_simp1 eSwap_simp1 withERR.inject)
subgoal using assms
by(simp_all add: igAbsIPresIGWls_def igSwapIPresIGWls_def igSwapIGAbs_def igWlsDisj_def)
(metis check_OK eAbs_nchotomy eSwap_invert) . . .
lemma errMOD_igSwapIGOpSTR:
assumes "igWlsAbsIsInBar MOD" and "igOpIPresIGWls MOD"
and "igSwapIPresIGWls MOD" and "igSwapAbsIPresIGWlsAbs MOD"
and "igWlsDisj MOD" and "igWlsAbsDisj MOD"
and "igSwapIGOp MOD"
shows "igSwapIGOpSTR (errMOD MOD)"
unfolding igSwapIGOpSTR_def proof(clarify)
have 0: "igSwapInpIPresIGWlsInp MOD ∧ igSwapBinpIPresIGWlsBinp MOD"
using ‹igSwapIPresIGWls MOD› ‹igSwapAbsIPresIGWlsAbs MOD›
imp_igSwapInpIPresIGWlsInp imp_igSwapBinpIPresIGWlsBinp by auto
have "igSwapIPresIGWlsSTR (errMOD MOD) ∧
igSwapAbsIPresIGWlsAbsSTR (errMOD MOD)"
using assms errMOD_igSwapIPresIGWlsSTR
errMOD_igSwapAbsIPresIGWlsAbsSTR by auto
hence 1: "igSwapInpIPresIGWlsInpSTR (errMOD MOD) ∧
igSwapBinpIPresIGWlsBinpSTR (errMOD MOD)"
using imp_igSwapInpIPresIGWlsInpSTR
imp_igSwapBinpIPresIGWlsBinpSTR by auto
fix zs::'varSort and z1 z2 ::'var and delta einp ebinp
let ?Left = "eSwap MOD zs z1 z2 (eOp MOD delta einp ebinp)"
let ?einpsw = "eSwapInp MOD zs z1 z2 einp"
let ?ebinpsw = "eSwapBinp MOD zs z1 z2 ebinp"
let ?Right = "eOp MOD delta ?einpsw ?ebinpsw"
show "?Left = ?Right"
proof(cases "liftAll (λeX. eX ≠ ERR) einp ∧
liftAll (λeA. eA ≠ ERR) ebinp")
case True note t = True
moreover obtain inp and binp where
"inp = checkI einp" and "binp = checkI ebinp" by blast
ultimately have einp: "einp = OKI inp" "ebinp = OKI binp" by auto
show ?thesis
proof(cases "igWlsInp MOD delta inp ∧ igWlsBinp MOD delta binp")
case False
hence "?Left = ERR" unfolding einp by auto
have "¬ (eWlsInp MOD delta einp ∧ eWlsBinp MOD delta ebinp)"
unfolding einp using False by auto
hence 2: "¬ (eWlsInp MOD delta ?einpsw ∧ eWlsBinp MOD delta ?ebinpsw)"
using 1 unfolding igSwapInpIPresIGWlsInpSTR_def
igSwapBinpIPresIGWlsBinpSTR_def by auto
{fix X assume "?Right = OK X"
then obtain inpsw and binpsw
where "?einpsw = OKI inpsw" and "?ebinpsw = OKI binpsw"
and "igWlsInp MOD delta inpsw" and "igWlsBinp MOD delta binpsw"
and "X = igOp MOD delta inpsw binpsw"
using eOp_invert[of MOD delta ?einpsw ?ebinpsw X] by auto
hence False using 2 by auto
}
with ‹?Left = ERR› show ?thesis by (cases ?Right) auto
next
case True
moreover have "igWls MOD (stOf delta) (igOp MOD delta inp binp)"
using True ‹igOpIPresIGWls MOD› unfolding igOpIPresIGWls_def by simp
moreover have "igWlsInp MOD delta (igSwapInp MOD zs z1 z2 inp) ∧
igWlsBinp MOD delta (igSwapBinp MOD zs z1 z2 binp)"
using 0 unfolding igSwapInpIPresIGWlsInp_def igSwapBinpIPresIGWlsBinp_def
using True by simp
ultimately show ?thesis using ‹igSwapIGOp MOD› unfolding einp igSwapIGOp_def by auto
qed
qed auto
qed
lemma errMOD_igSwapClsSTR:
assumes "igWlsAllDisj MOD" and "igWlsDisj MOD"
and "igWlsAbsIsInBar MOD" and "igConsIPresIGWls MOD"
and "igSwapAllIPresIGWlsAll MOD" and "igSwapCls MOD"
shows "igSwapClsSTR (errMOD MOD)"
using assms
unfolding igWlsAllDisj_def igConsIPresIGWls_def igSwapCls_def
igSwapAllIPresIGWlsAll_def igSwapClsSTR_def
using
errMOD_igSwapIGVarSTR[of MOD]
errMOD_igSwapIGAbsSTR[of MOD]
errMOD_igSwapIGOpSTR[of MOD]
by simp
text‹The strong ``subst" clauses are satisfied:›
lemma errMOD_igSubstIGVar1STR:
assumes "igVarIPresIGWls MOD" and "igSubstIGVar1 MOD"
shows "igSubstIGVar1STR (errMOD MOD)"
using assms
by (simp add: igSubstIGVar1STR_def igVarIPresIGWls_def igSubstIGVar1_def)
(metis eSubst_simp1 eWls_invert)
lemma errMOD_igSubstIGVar2STR:
assumes "igVarIPresIGWls MOD" and "igSubstIGVar2 MOD"
shows "igSubstIGVar2STR (errMOD MOD)"
using assms
by (simp add: igSubstIGVar2STR_def igVarIPresIGWls_def igSubstIGVar2_def)
(metis eSubst_simp1 eWls_invert)
lemma errMOD_igSubstIGAbsSTR:
fixes MOD :: "('index,'bindex,'varSort,'sort,'opSym,'var,'gTerm,'gAbs)model"
assumes *: "igAbsIPresIGWls MOD" and **: "igWlsDisj MOD"
and ***: "igSubstIPresIGWls MOD" and ****: "igSubstIGAbs MOD"
shows "igSubstIGAbsSTR (errMOD MOD)"
unfolding igSubstIGAbsSTR_def proof(clarify)
fix ys xs ::'varSort and y x ::'var and eX eY
assume diff: "xs ≠ ys ∨ x ≠ y"
and x_fresh_Y: "eFresh MOD xs x eY"
show "eSubstAbs MOD ys eY y (eAbs MOD xs x eX) =
eAbs MOD xs x (eSubst MOD ys eY y eX)"
proof(cases "eX ≠ ERR ∧ eY ≠ ERR")
case True
define X and Y where "X ≡ check eX" and "Y ≡ check eY"
hence eX: "eX = OK X" and eY: "eY = OK Y" unfolding X_def Y_def
using True OK_check by auto
show ?thesis
proof(cases "(∃ s. isInBar (xs,s) ∧ igWls MOD s X) ∧ igWls MOD (asSort ys) Y")
case True
then obtain s where xs_s: "isInBar (xs, s)" and X: "igWls MOD s X"
and Y: "igWls MOD (asSort ys) Y" by auto
hence "igWlsAbs MOD (xs,s) (igAbs MOD xs x X)"
using * unfolding igAbsIPresIGWls_def by simp
moreover have "igWls MOD s (igSubst MOD ys Y y X)"
using X Y *** unfolding igSubstIPresIGWls_def by simp
moreover have "igFresh MOD xs x Y"
using x_fresh_Y Y unfolding eY by simp
ultimately show ?thesis unfolding eX eY
using xs_s X Y apply simp
using x_fresh_Y diff **** unfolding igSubstIGAbs_def by fastforce
next
case False
show ?thesis
proof(cases "(EX s. igWls MOD s X) ∧ igWls MOD (asSort ys) Y")
case True
then obtain s where X: "igWls MOD s X" and Y: "igWls MOD (asSort ys) Y" by auto
hence 2: "~ isInBar (xs,s)" using False by (auto simp: eX eY)
let ?Xsb = "igSubst MOD ys Y y X"
have Xsb: "igWls MOD s ?Xsb"
using Y X *** unfolding igSubstIPresIGWls_def by auto
{fix s' assume 3: "isInBar (xs,s')" and "igWls MOD s' ?Xsb"
hence "s = s'" using Xsb ** unfolding igWlsDisj_def by auto
hence False using 2 3 by (simp add: eX eY)
}
thus ?thesis using False Y eAbs_simp2 X eX eY by fastforce
qed(auto simp add: eX eY)
qed
qed auto
qed
lemma errMOD_igSubstIGOpSTR:
assumes "igWlsAbsIsInBar MOD"
and "igVarIPresIGWls MOD" and "igOpIPresIGWls MOD"
and "igSubstIPresIGWls MOD" and "igSubstAbsIPresIGWlsAbs MOD"
and "igWlsDisj MOD" and "igWlsAbsDisj MOD"
and "igSubstIGOp MOD"
shows "igSubstIGOpSTR (errMOD MOD)"
proof-
have 0: "igSubstInpIPresIGWlsInp MOD ∧ igSubstBinpIPresIGWlsBinp MOD"
using ‹igSubstIPresIGWls MOD› ‹igSubstAbsIPresIGWlsAbs MOD›
imp_igSubstInpIPresIGWlsInp imp_igSubstBinpIPresIGWlsBinp by auto
have "igSubstIPresIGWlsSTR (errMOD MOD) ∧ igSubstAbsIPresIGWlsAbsSTR (errMOD MOD)"
using assms errMOD_igSubstIPresIGWlsSTR errMOD_igSubstAbsIPresIGWlsAbsSTR by auto
hence 1: "igSubstInpIPresIGWlsInpSTR (errMOD MOD) ∧
igSubstBinpIPresIGWlsBinpSTR (errMOD MOD)"
using imp_igSubstInpIPresIGWlsInpSTR imp_igSubstBinpIPresIGWlsBinpSTR by auto
show ?thesis
unfolding igSubstIGOpSTR_def proof safe
fix ys::'varSort and y y1 ::'var and delta einp ebinp
let ?Left = "eSubst MOD ys (eVar MOD ys y1) y (eOp MOD delta einp ebinp)"
let ?einpsb = "eSubstInp MOD ys (eVar MOD ys y1) y einp"
let ?ebinpsb = "eSubstBinp MOD ys (eVar MOD ys y1) y ebinp"
let ?Right = "eOp MOD delta ?einpsb ?ebinpsb"
show "?Left = ?Right"
proof(cases "liftAll (λeX. eX ≠ ERR) einp ∧ liftAll (λeA. eA ≠ ERR) ebinp")
case True
moreover obtain inp binp where
"inp = checkI einp" and "binp = checkI ebinp" by blast
ultimately have einp: "einp = OKI inp" "ebinp = OKI binp" by auto
have igWls_y1: "igWls MOD (asSort ys) (igVar MOD ys y1)"
using ‹igVarIPresIGWls MOD› unfolding igVarIPresIGWls_def by simp
show ?thesis
proof(cases "igWlsInp MOD delta inp ∧ igWlsBinp MOD delta binp")
case False
hence "?Left = ERR" unfolding einp by auto
have "¬ (eWlsInp MOD delta einp ∧ eWlsBinp MOD delta ebinp)"
unfolding einp using False by simp
hence 2: "¬ (eWlsInp MOD delta ?einpsb ∧ eWlsBinp MOD delta ?ebinpsb)"
using igWls_y1 1
unfolding igSubstInpIPresIGWlsInpSTR_def igSubstBinpIPresIGWlsBinpSTR_def by simp
{fix X assume "?Right = OK X"
then obtain inpsb binpsb where
"?einpsb = OKI inpsb" and "?ebinpsb = OKI binpsb"
and "igWlsInp MOD delta inpsb" and "igWlsBinp MOD delta binpsb"
and "X = igOp MOD delta inpsb binpsb"
using eOp_invert[of MOD delta ?einpsb ?ebinpsb X] by auto
hence False using 2 by auto
}
hence "?Right = ERR" by (cases ?Right, auto)
with ‹?Left = ERR› show ?thesis by simp
next
case True
moreover have "igWls MOD (stOf delta) (igOp MOD delta inp binp)"
using True ‹igOpIPresIGWls MOD› unfolding igOpIPresIGWls_def by simp
moreover
have "igWlsInp MOD delta (igSubstInp MOD ys (igVar MOD ys y1) y inp) ∧
igWlsBinp MOD delta (igSubstBinp MOD ys (igVar MOD ys y1) y binp)"
using 0 unfolding igSubstInpIPresIGWlsInp_def igSubstBinpIPresIGWlsBinp_def
using True igWls_y1 by simp
ultimately show ?thesis
using ‹igSubstIGOp MOD› igWls_y1 unfolding einp igSubstIGOp_def by auto
qed
qed auto
next
fix ys::'varSort and y ::'var and eY delta einp ebinp
assume eY: "eWls MOD (asSort ys) eY"
let ?Left = "eSubst MOD ys eY y (eOp MOD delta einp ebinp)"
let ?einpsb = "eSubstInp MOD ys eY y einp"
let ?ebinpsb = "eSubstBinp MOD ys eY y ebinp"
let ?Right = "eOp MOD delta ?einpsb ?ebinpsb"
from eY obtain Y where eY_def: "eY = OK Y"
and Y: "igWls MOD (asSort ys) Y" using eWls_invert[of MOD "asSort ys" eY] by auto
show "?Left = ?Right"
proof(cases "liftAll (λeX. eX ≠ ERR) einp ∧ liftAll (λeA. eA ≠ ERR) ebinp")
case True
moreover obtain inp binp where
"inp = checkI einp" and "binp = checkI ebinp" by blast
ultimately have einp: "einp = OKI inp" "ebinp = OKI binp" by auto
show ?thesis
proof(cases "igWlsInp MOD delta inp ∧ igWlsBinp MOD delta binp")
case False
hence "?Left = ERR" unfolding einp by auto
have "¬ (eWlsInp MOD delta einp ∧ eWlsBinp MOD delta ebinp)"
unfolding einp using False by simp
hence 2: "¬ (eWlsInp MOD delta ?einpsb ∧ eWlsBinp MOD delta ?ebinpsb)"
unfolding eY_def using Y 1
unfolding igSubstInpIPresIGWlsInpSTR_def igSubstBinpIPresIGWlsBinpSTR_def by simp
{fix X assume "?Right = OK X"
then obtain inpsb binpsb
where "?einpsb = OKI inpsb" and "?ebinpsb = OKI binpsb"
and "igWlsInp MOD delta inpsb" and "igWlsBinp MOD delta binpsb"
and "X = igOp MOD delta inpsb binpsb"
using eOp_invert[of MOD delta ?einpsb ?ebinpsb X] by auto
hence False using 2 by auto
}
hence "?Right = ERR" by (cases ?Right, auto)
with ‹?Left = ERR› show ?thesis by simp
next
case True
moreover have "igWls MOD (stOf delta) (igOp MOD delta inp binp)"
using True ‹igOpIPresIGWls MOD› unfolding igOpIPresIGWls_def by simp
moreover
have "igWlsInp MOD delta (igSubstInp MOD ys Y y inp) ∧
igWlsBinp MOD delta (igSubstBinp MOD ys Y y binp)"
using 0 unfolding igSubstInpIPresIGWlsInp_def igSubstBinpIPresIGWlsBinp_def
using True Y by simp
ultimately show ?thesis unfolding einp eY_def
using ‹igSubstIGOp MOD› Y unfolding igSubstIGOp_def by auto
qed
qed auto
qed
qed
lemma errMOD_igSubstClsSTR:
assumes "igWlsAllDisj MOD" and "igConsIPresIGWls MOD"
and "igWlsAbsIsInBar MOD"
and "igSubstAllIPresIGWlsAll MOD" and "igSubstCls MOD"
shows "igSubstClsSTR (errMOD MOD)"
using assms
unfolding igWlsAllDisj_def igConsIPresIGWls_def igSubstCls_def
igSubstAllIPresIGWlsAll_def igSubstClsSTR_def
using
errMOD_igSubstIGVar1STR[of MOD] errMOD_igSubstIGVar2STR[of MOD]
errMOD_igSubstIGAbsSTR[of MOD]
errMOD_igSubstIGOpSTR[of MOD]
by simp
text‹Strong swap-based congruence for abstractions holds:›
lemma errMOD_igAbsCongSSTR:
assumes "igSwapIPresIGWls MOD" and "igWlsDisj MOD" and "igAbsCongS MOD"
shows "igAbsCongSSTR (errMOD MOD)"
unfolding igAbsCongSSTR_def proof(clarify)
fix xs ::'varSort and x x' y ::'var and eX eX'
assume *: "eFresh MOD xs y eX" and **: "eFresh MOD xs y eX'"
and ***: "eSwap MOD xs y x eX = eSwap MOD xs y x' eX'"
let ?phi = "λeX. eX = ERR ∨ (∃ X. eX = OK X ∧ (∀ s. ¬ igWls MOD s X))"
have 1: "?phi eX = ?phi eX'"
proof
assume "?phi eX"
{fix X' s' assume "eX' = OK X' ∧ (∃ s. igWls MOD s X')"
hence "ERR = OK (igSwap MOD xs y x' X')" using ‹?phi eX› *** by auto
}
thus "?phi eX'" by(cases eX', auto)
next
assume "?phi eX'"
{fix X assume "eX = OK X ∧ (∃ s. igWls MOD s X)"
hence "ERR = OK (igSwap MOD xs y x X)" using ‹?phi eX'› *** by auto
}
thus "?phi eX" by(cases eX, auto)
qed
show "eAbs MOD xs x eX = eAbs MOD xs x' eX'"
proof(cases "?phi eX")
case True
thus ?thesis using 1 by auto
next
case False
then obtain s X where eX: "eX = OK X" and X_wls: "igWls MOD s X" by(cases eX, auto)
obtain s' X' where eX': "eX' = OK X'" and X'_wls: "igWls MOD s' X'"
using ‹¬ ?phi eX› 1 by(cases eX') auto
hence "igSwap MOD xs y x X = igSwap MOD xs y x' X'"
using eX X_wls *** by auto
moreover have "igWls MOD s (igSwap MOD xs y x X)"
using X_wls ‹igSwapIPresIGWls MOD› unfolding igSwapIPresIGWls_def by simp
moreover have "igWls MOD s' (igSwap MOD xs y x' X')"
using X'_wls ‹igSwapIPresIGWls MOD› unfolding igSwapIPresIGWls_def by simp
ultimately have "s' = s" using ‹igWlsDisj MOD› unfolding igWlsDisj_def by auto
show ?thesis
proof (cases "isInBar (xs,s)")
case True
have "igFresh MOD xs y X" using * X_wls unfolding eX by simp
moreover have "igFresh MOD xs y X'" using ** X'_wls unfolding eX' by simp
moreover have "igSwap MOD xs y x X = igSwap MOD xs y x' X'"
using *** X_wls X'_wls unfolding eX eX' by simp
ultimately show ?thesis
unfolding eX eX'
using X_wls X'_wls unfolding ‹s' = s›
using ‹igAbsCongS MOD› True unfolding igAbsCongS_def
by (metis FixSyn.eCons_simps(2) FixSyn_axioms)
next
case False
{fix s'' assume xs_s'': "isInBar (xs,s'')" and "igWls MOD s'' X"
hence "s = s''" using X_wls ‹igWlsDisj MOD› unfolding igWlsDisj_def by auto
hence False using False xs_s'' by simp
}
moreover
{fix s'' assume xs_s'': "isInBar (xs,s'')" and "igWls MOD s'' X'"
hence "s = s''" using X'_wls ‹igWlsDisj MOD› unfolding igWlsDisj_def ‹s' = s› by auto
hence False using False xs_s'' by simp
}
ultimately show ?thesis
using eX eX' X_wls X'_wls unfolding ‹s' = s› by fastforce
qed
qed
qed
text‹The renaming clause for abstractions holds:›
lemma errMOD_igAbsRenSTR:
assumes "igVarIPresIGWls MOD" and "igSubstIPresIGWls MOD"
and "igWlsDisj MOD" and "igAbsRen MOD"
shows "igAbsRenSTR (errMOD MOD)"
using assms unfolding igAbsRenSTR_def apply clarify
subgoal for xs y x eX
apply(cases eX)
subgoal by auto
subgoal for X
apply(cases "EX s. isInBar (xs,s) ∧ igWls MOD s X")
subgoal by (auto simp: igVarIPresIGWls_def igSubstIPresIGWls_def igAbsRen_def)
subgoal using assms by (simp add: igVarIPresIGWls_def igSubstIPresIGWls_def igAbsRen_def igWlsDisj_def)
(metis eAbs_simp2 eAbs_simp3 eSubst_simp1 eSubst_simp3) . . .
text‹Strong subst-based congruence for abstractions holds:›
corollary errMOD_igAbsCongUSTR:
assumes "igVarIPresIGWls MOD" and "igSubstIPresIGWls MOD"
and "igWlsDisj MOD" and "igAbsRen MOD"
shows "igAbsCongUSTR (errMOD MOD)"
using assms errMOD_igAbsRenSTR igAbsRenSTR_imp_igAbsCongUSTR by auto
text‹The error model is a strongly well-sorted fresh-swap model:›
lemma errMOD_iwlsFSwSTR:
fixes MOD :: "('index,'bindex,'varSort,'sort,'opSym,'var,'gTerm,'gAbs) model"
assumes "iwlsFSw MOD"
shows "iwlsFSwSTR (errMOD MOD)"
using assms unfolding iwlsFSw_def iwlsFSwSTR_def
using errMOD_igWlsAllDisj[of MOD]
errMOD_igWlsAbsIsInBar[of MOD]
errMOD_igConsIPresIGWlsSTR[of MOD]
errMOD_igSwapAllIPresIGWlsAllSTR[of MOD]
errMOD_igFreshClsSTR[of MOD] errMOD_igSwapClsSTR[of MOD]
errMOD_igAbsCongSSTR[of MOD]
apply simp
unfolding igSwapAllIPresIGWlsAll_def igWlsAllDisj_defs by simp
text‹The error model is a strongly well-sorted fresh-subst model:›
lemma errMOD_iwlsFSbSwTR:
fixes MOD :: "('index,'bindex,'varSort,'sort,'opSym,'var,'gTerm,'gAbs) model"
assumes "iwlsFSb MOD"
shows "iwlsFSbSwTR (errMOD MOD)"
using assms unfolding iwlsFSb_def iwlsFSbSwTR_def
using errMOD_igWlsAllDisj[of MOD]
errMOD_igWlsAbsIsInBar[of MOD]
errMOD_igConsIPresIGWlsSTR[of MOD]
errMOD_igSubstAllIPresIGWlsAllSTR[of MOD]
errMOD_igFreshClsSTR[of MOD] errMOD_igSubstClsSTR[of MOD]
errMOD_igAbsRenSTR[of MOD]
by (simp add: igConsIPresIGWls_def igSubstAllIPresIGWlsAll_def igWlsAllDisj_defs)
subsubsection ‹The natural morhpism from an error model to its original model›
text‹This morphism is igiven by the ``check" functions.›
text‹Preservation of the domains:›
lemma check_ipresIGWls:
"ipresIGWls check (errMOD MOD) MOD"
unfolding ipresIGWls_def apply clarify
subgoal for _ X by(cases X) auto .
lemma check_ipresIGWlsAbs:
"ipresIGWlsAbs check (errMOD MOD) MOD"
unfolding ipresIGWlsAbs_def apply clarify
subgoal for _ _ A by(cases A) auto .
lemma check_ipresIGWlsAll:
"ipresIGWlsAll check check (errMOD MOD) MOD"
unfolding ipresIGWlsAll_def
using check_ipresIGWls check_ipresIGWlsAbs by auto
text‹Preservation of the operations:›
lemma check_ipresIGVar:
"ipresIGVar check (errMOD MOD) MOD"
unfolding ipresIGVar_def by simp
lemma check_ipresIGAbs:
"ipresIGAbs check check (errMOD MOD) MOD"
unfolding ipresIGAbs_def apply clarify
subgoal for _ _ _ X by(cases X) auto .
lemma check_ipresIGOp:
"ipresIGOp check check (errMOD MOD) MOD"
unfolding ipresIGOp_def proof clarify
fix delta einp ebinp
assume "eWlsInp MOD delta einp" and "eWlsBinp MOD delta ebinp"
then obtain inp binp where
"igWlsInp MOD delta inp" and "igWlsBinp MOD delta binp"
and "einp = OKI inp" and "ebinp = OKI binp"
using eWlsInp_invert eWlsBinp_invert by blast
hence "check (eOp MOD delta einp ebinp) =
igOp MOD delta (checkI einp) (checkI ebinp)" by simp
thus "check (eOp MOD delta einp ebinp) =
igOp MOD delta (lift check einp) (lift check ebinp)"
unfolding checkI_def .
qed
lemma check_ipresIGCons:
"ipresIGCons check check (errMOD MOD) MOD"
unfolding ipresIGCons_def
using
check_ipresIGVar
check_ipresIGAbs
check_ipresIGOp
by auto
lemma check_ipresIGFresh:
"ipresIGFresh check (errMOD MOD) MOD"
unfolding ipresIGFresh_def apply clarify
subgoal for _ _ _ X by(cases X) auto .
lemma check_ipresIGFreshAbs:
"ipresIGFreshAbs check (errMOD MOD) MOD"
unfolding ipresIGFreshAbs_def apply clarify
subgoal for _ _ _ _ A by(cases A) auto .
lemma check_ipresIGFreshAll:
"ipresIGFreshAll check check (errMOD MOD) MOD"
unfolding ipresIGFreshAll_def
using check_ipresIGFresh check_ipresIGFreshAbs by auto
lemma check_ipresIGSwap:
"ipresIGSwap check (errMOD MOD) MOD"
unfolding ipresIGSwap_def apply clarify
subgoal for _ _ _ _ X by(cases X) auto .
lemma check_ipresIGSwapAbs:
"ipresIGSwapAbs check (errMOD MOD) MOD"
unfolding ipresIGSwapAbs_def apply clarify
subgoal for _ _ _ _ _ A by(cases A) auto .
lemma check_ipresIGSwapAll:
"ipresIGSwapAll check check (errMOD MOD) MOD"
unfolding ipresIGSwapAll_def
using check_ipresIGSwap check_ipresIGSwapAbs by auto
lemma check_ipresIGSubst:
"ipresIGSubst check (errMOD MOD) MOD"
unfolding ipresIGSubst_def apply clarify
subgoal for _ Y _ _ X by (cases X, simp, cases Y) auto .
lemma check_ipresIGSubstAbs:
"ipresIGSubstAbs check check (errMOD MOD) MOD"
unfolding ipresIGSubstAbs_def apply clarify
subgoal for _ Y _ _ _ A by (cases A, simp, cases Y) auto .
lemma check_ipresIGSubstAll:
"ipresIGSubstAll check check (errMOD MOD) MOD"
unfolding ipresIGSubstAll_def
using check_ipresIGSubst check_ipresIGSubstAbs by auto
text‹``check" is a fresh-swap morphism:›
lemma check_FSwImorph:
"FSwImorph check check (errMOD MOD) MOD"
unfolding FSwImorph_def
using check_ipresIGWlsAll check_ipresIGCons
check_ipresIGFreshAll check_ipresIGSwapAll by auto
text‹``check" is a fresh-subst morphism:›
lemma check_FSbImorph:
"FSbImorph check check (errMOD MOD) MOD"
unfolding FSbImorph_def
using check_ipresIGWlsAll check_ipresIGCons
check_ipresIGFreshAll check_ipresIGSubstAll by auto
subsection ‹Initiality of the models of terms›
text ‹We show that terms form initial models in all the considered kinds.
The desired initial morphism will be the composition of ``check" with the
factorization of the standard (absolute-initial) function from quasi-terms, ``qInit",
to alpha-equivalence.
``qInit" preserving alpha-equivalence (in an unsorted fashion)
was the main reason for introducing error models.›
declare qItem_simps[simp]
declare qItem_versus_item_simps[simp]
declare good_item_simps[simp]
subsubsection ‹The initial map from quasi-terms to a strong model›
definition
aux_qInit_ignoreFirst ::
"('index,'bindex,'varSort,'sort,'opSym,'var,'gTerm,'gAbs)model *
('index,'bindex,'varSort,'var,'opSym)qTerm +
('index,'bindex,'varSort,'sort,'opSym,'var,'gTerm,'gAbs)model *
('index,'bindex,'varSort,'var,'opSym)qAbs ⇒
('index,'bindex,'varSort,'var,'opSym)qTermItem"
where
"aux_qInit_ignoreFirst K =
(case K of Inl (MOD,qX) ⇒ termIn qX
|Inr (MOD,qA) ⇒ absIn qA)"
lemma qTermLess_ingoreFirst_wf:
"wf (inv_image qTermLess aux_qInit_ignoreFirst)"
using qTermLess_wf wf_inv_image by auto
function
qInit :: "('index,'bindex,'varSort,'sort,'opSym,'var,'gTerm,'gAbs)model ⇒
('index,'bindex,'varSort,'var,'opSym)qTerm ⇒ 'gTerm"
and
qInitAbs :: "('index,'bindex,'varSort,'sort,'opSym,'var,'gTerm,'gAbs)model ⇒
('index,'bindex,'varSort,'var,'opSym)qAbs ⇒ 'gAbs"
where
"qInit MOD (qVar xs x) = igVar MOD xs x"
|
"qInit MOD (qOp delta qinp qbinp) =
igOp MOD delta (lift (qInit MOD) qinp) (lift (qInitAbs MOD) qbinp)"
|
"qInitAbs MOD (qAbs xs x qX) = igAbs MOD xs x (qInit MOD qX)"
by(pat_completeness) auto
termination
apply(relation "inv_image qTermLess aux_qInit_ignoreFirst")
apply(simp add: qTermLess_ingoreFirst_wf)
by(auto simp: qTermLess_def aux_qInit_ignoreFirst_def)
lemma qFreshAll_igFreshAll_qInitAll:
assumes "igFreshClsSTR MOD"
shows
"(qFresh ys y qX ⟶ igFresh MOD ys y (qInit MOD qX)) ∧
(qFreshAbs ys y qA ⟶ igFreshAbs MOD ys y (qInitAbs MOD qA))"
apply(induct rule: qTerm_rawInduct)
using assms
by (auto simp: igFreshClsSTR_def igFreshIGVar_def qFreshInp_def qFreshBinp_def liftAll_lift_comp
liftAll_def igFreshInp_def igFreshBinp_def lift_def igFreshIGAbs1STR_def igFreshIGAbs2STR_def igFreshIGOpSTR_def
split: option.splits)
corollary iwlsFSwSTR_qFreshAll_igFreshAll_qInitAll:
assumes "iwlsFSwSTR MOD"
shows
"(qFresh ys y qX ⟶ igFresh MOD ys y (qInit MOD qX)) ∧
(qFreshAbs ys y qA ⟶ igFreshAbs MOD ys y (qInitAbs MOD qA))"
using assms unfolding iwlsFSwSTR_def by(simp add: qFreshAll_igFreshAll_qInitAll)
corollary iwlsFSbSwTR_qFreshAll_igFreshAll_qInitAll:
assumes "iwlsFSbSwTR MOD"
shows
"(qFresh ys y qX ⟶ igFresh MOD ys y (qInit MOD qX)) ∧
(qFreshAbs ys y qA ⟶ igFreshAbs MOD ys y (qInitAbs MOD qA))"
using assms unfolding iwlsFSbSwTR_def by(simp add: qFreshAll_igFreshAll_qInitAll)
lemma qSwapAll_igSwapAll_qInitAll:
assumes "igSwapClsSTR MOD"
shows
"qInit MOD (qX #[[ z1 ∧ z2]]_zs) = igSwap MOD zs z1 z2 (qInit MOD qX) ∧
qInitAbs MOD (qA $[[z1 ∧ z2]]_zs) = igSwapAbs MOD zs z1 z2 (qInitAbs MOD qA)"
proof(induction rule: qTerm_rawInduct)
case (Var xs x)
then show ?case using assms unfolding igSwapClsSTR_def igSwapIGVar_def by simp
next
case (Op delta qinp qbinp)
hence "lift (qInit MOD) (qSwapInp zs z1 z2 qinp) =
igSwapInp MOD zs z1 z2 (lift (qInit MOD) qinp) ∧
lift (qInitAbs MOD) (qSwapBinp zs z1 z2 qbinp) =
igSwapBinp MOD zs z1 z2 (lift (qInitAbs MOD) qbinp)"
using Op.IH by (auto simp: qSwapInp_def qSwapBinp_def igSwapInp_def lift_def liftAll_def
igSwapBinp_def iwlsFSwSTR_def igSwapClsSTR_def igSwapIGOpSTR_def
split: option.splits)
thus ?case
using assms unfolding iwlsFSwSTR_def igSwapClsSTR_def igSwapIGOpSTR_def by simp
next
case (Abs xs x X)
then show ?case using assms unfolding igSwapClsSTR_def igSwapIGAbsSTR_def by simp
qed
corollary iwlsFSwSTR_qSwapAll_igSwapAll_qInitAll:
assumes wls: "iwlsFSwSTR MOD"
shows
"qInit MOD (qX #[[ z1 ∧ z2]]_zs) = igSwap MOD zs z1 z2 (qInit MOD qX) ∧
qInitAbs MOD (qA $[[z1 ∧ z2]]_zs) = igSwapAbs MOD zs z1 z2 (qInitAbs MOD qA)"
using assms unfolding iwlsFSwSTR_def by(simp add: qSwapAll_igSwapAll_qInitAll)
lemma qSwapAll_igSubstAll_qInitAll:
fixes qX::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
qA::"('index,'bindex,'varSort,'var,'opSym)qAbs"
assumes *: "igSubstClsSTR MOD" and "igFreshClsSTR MOD"
and "igAbsRenSTR MOD"
shows
"(qGood qX ⟶
(∀ ys y1 y.
qAFresh ys y1 qX ⟶
qInit MOD (qX #[[y1 ∧ y]]_ys) = igSubst MOD ys (igVar MOD ys y1) y (qInit MOD qX)))
∧
(qGoodAbs qA ⟶
(∀ ys y1 y.
qAFreshAbs ys y1 qA ⟶
qInitAbs MOD (qA $[[y1 ∧ y]]_ys) = igSubstAbs MOD ys (igVar MOD ys y1) y (qInitAbs MOD qA)))"
proof(induction rule: qGood_qTerm_induct)
case (Var xs x)
show ?case apply safe
subgoal for ys y1 y using *
by (cases "ys = xs ∧ y = x")
(auto simp: igSubstClsSTR_defs igSubstIGVar2STR_def igSubstClsSTR_defs igSubstIGVar1STR_def).
next
let ?h = "qInit MOD" let ?hA = "qInitAbs MOD"
case (Op delta qinp qbinp)
then show ?case proof safe
fix ys y1 y
assume ***: "qAFresh ys y1 (qOp delta qinp qbinp)"
have "lift ?h (qSwapInp ys y1 y qinp) =
igSubstInp MOD ys (igVar MOD ys y1) y (lift ?h qinp) ∧
lift ?hA (qSwapBinp ys y1 y qbinp) =
igSubstBinp MOD ys (igVar MOD ys y1) y (lift ?hA qbinp)"
using Op.IH ***
by (auto simp: qSwapInp_def igSubstInp_def qSwapBinp_def igSubstBinp_def
lift_def liftAll_def split: option.splits)
thus "qInit MOD (qOp delta qinp qbinp #[[y1 ∧ y]]_ys) =
igSubst MOD ys (igVar MOD ys y1) y (qInit MOD (qOp delta qinp qbinp))"
using assms unfolding iwlsFSwSTR_def igSubstClsSTR_defs igSubstIGOpSTR_def by simp
qed
next
let ?h = "qInit MOD" let ?hA = "qInitAbs MOD"
case (Abs xs x qX)
show ?case proof safe
fix ys y1 y
let ?xy1y = "x @xs[y1 ∧ y]_ys" let ?y1 = "igVar MOD ys y1"
assume "qAFreshAbs ys y1 (qAbs xs x qX)"
hence y1_fresh: "ys = xs ⟶ y1 ≠ x" "qAFresh ys y1 qX" by auto
hence 1: "qFresh ys y1 qX" using qAFresh_imp_qFresh by auto
hence y1_fresh_qX: "igFresh MOD ys y1 (?h qX)"
using assms unfolding igSubstClsSTR_def
by(simp add: qFreshAll_igFreshAll_qInitAll)
obtain x1 where x1_fresh: "x1 ∉ {y,y1}" "qFresh xs x1 qX" "qAFresh xs x1 qX"
using obtain_qFresh[of "{y,y1}" "{qX}"] using Abs by blast
hence [simp]: "igFresh MOD xs x1 (?h qX)"
using assms by(simp add: qFreshAll_igFreshAll_qInitAll)
let ?x1 = "igVar MOD xs x1" let ?x1y1y = "x1 @xs[y1 ∧ y]_ys"
let ?qX_x1x = "qX #[[x1 ∧ x]]_xs" let ?qX_x1x_y1y = "?qX_x1x #[[y1 ∧ y]]_ys"
let ?qX_y1y = "qX #[[y1 ∧ y]]_ys" let ?qX_y1y_x1_xy1y = "?qX_y1y #[[x1 ∧ ?xy1y]]_xs"
let ?qX_y1y_x1y1y_xy1y = "?qX_y1y #[[?x1y1y ∧ ?xy1y]]_xs"
have [simp]: "qAFresh ys y1 ?qX_x1x"
using y1_fresh x1_fresh by(auto simp add: qSwap_preserves_qAFresh_distinct)
have [simp]: "qAFresh xs x1 ?qX_y1y"
using y1_fresh x1_fresh by(auto simp add: qSwap_preserves_qAFresh_distinct)
hence "qFresh xs x1 ?qX_y1y" by (simp add: qAFresh_imp_qFresh)
hence [simp]: "igFresh MOD xs x1 (?h ?qX_y1y)"
using assms by(simp add: qFreshAll_igFreshAll_qInitAll)
have [simp]: "igFresh MOD xs x1 ?y1"
using x1_fresh assms unfolding igFreshClsSTR_def igFreshIGVar_def by simp
have x1_def: "x1 = ?x1y1y" using x1_fresh by simp
have "?hA ((qAbs xs x qX) $[[y1 ∧ y]]_ys) = igAbs MOD xs ?xy1y (?h ?qX_y1y)" by simp
also have "… = igAbs MOD xs x1 (igSubst MOD xs ?x1 ?xy1y (?h ?qX_y1y))"
using assms unfolding igAbsRenSTR_def by simp
also have "igSubst MOD xs ?x1 ?xy1y (?h ?qX_y1y) = ?h (?qX_y1y_x1_xy1y)"
using y1_fresh Abs.IH[of "?qX_y1y"] by(simp add: qSwap_qSwapped)
also have "?qX_y1y_x1_xy1y = ?qX_y1y_x1y1y_xy1y" using x1_def by simp
also have "… = ?qX_x1x_y1y" apply(rule sym) by(rule qSwap_compose)
also have "?h ?qX_x1x_y1y = igSubst MOD ys ?y1 y (?h ?qX_x1x)"
using Abs.IH[of "?qX_x1x"] by(simp add: qSwap_qSwapped)
also have
"igAbs MOD xs x1 (igSubst MOD ys ?y1 y (?h ?qX_x1x)) =
igSubstAbs MOD ys ?y1 y (igAbs MOD xs x1 (?h (?qX_x1x)))"
using assms unfolding igSubstClsSTR_def igSubstIGAbsSTR_def
using x1_fresh y1_fresh by simp
also have "?h (?qX_x1x) = igSubst MOD xs ?x1 x (?h qX)"
using Abs.IH[of "qX"] x1_fresh by(simp add: qSwapped.Refl)
also have
"igAbs MOD xs x1 (igSubst MOD xs ?x1 x (?h qX)) =
igAbs MOD xs x (?h qX)"
using assms unfolding igAbsRenSTR_def by simp
also have "igAbs MOD xs x (?h qX) = ?hA (qAbs xs x qX)"
using assms by simp
finally show "?hA ((qAbs xs x qX) $[[y1 ∧ y]]_ys) =
igSubstAbs MOD ys ?y1 y (?hA (qAbs xs x qX))" .
qed
qed
lemma iwlsFSbSwTR_qSwapAll_igSubstAll_qInitAll:
assumes wls: "iwlsFSbSwTR MOD"
shows
"(qGood qX ⟶
qAFresh ys y1 qX ⟶
qInit MOD (qX #[[y1 ∧ y]]_ys) = igSubst MOD ys (igVar MOD ys y1) y (qInit MOD qX))
∧
(qGoodAbs qA ⟶
qAFreshAbs ys y1 qA ⟶
qInitAbs MOD (qA $[[y1 ∧ y]]_ys) = igSubstAbs MOD ys (igVar MOD ys y1) y (qInitAbs MOD qA))"
using assms unfolding iwlsFSbSwTR_def by(simp add: qSwapAll_igSubstAll_qInitAll)
lemma iwlsFSwSTR_alphaAll_qInitAll:
assumes "iwlsFSwSTR MOD"
shows
"(∀ qX'. qX #= qX' ⟶ qInit MOD qX = qInit MOD qX') ∧
(∀ qA'. qA $= qA' ⟶ qInitAbs MOD qA = qInitAbs MOD qA')"
proof(induction rule: qTerm_induct)
case (Var xs x)
then show ?case by(simp add: qVar_alpha_iff)
next
case (Op delta qinp qbinp)
show ?case proof safe
fix qX'
assume "qOp delta qinp qbinp #= qX'"
then obtain qinp' qbinp' where qX': "qX' = qOp delta qinp' qbinp'"
and *: "sameDom qinp qinp' ∧ sameDom qbinp qbinp'"
and **: "liftAll2 (λqX qX'. qX #= qX') qinp qinp' ∧
liftAll2 (λqA qA'. qA $= qA') qbinp qbinp'"
using qOp_alpha_iff[of delta qinp qbinp qX'] by auto
hence "lift (qInit MOD) qinp = lift (qInit MOD) qinp'"
by (smt Op.IH(1) liftAll2_def liftAll2_lift_ext liftAll_def)
moreover have "lift (qInitAbs MOD) qbinp = lift (qInitAbs MOD) qbinp'"
by (smt * ** Op.IH(2) liftAll2_def liftAll2_lift_ext liftAll_def)
ultimately
show "qInit MOD (qOp delta qinp qbinp) = qInit MOD qX'" unfolding qX' by simp
qed
next
case (Abs xs x qX)
show ?case proof safe
fix qA'
assume "qAbs xs x qX $= qA'"
then obtain x' y qX' where qA': "qA' = qAbs xs x' qX'"
and y_not: "y ∉ {x, x'}" and "qAFresh xs y qX" "qAFresh xs y qX'"
and alpha: "(qX #[[y ∧ x]]_xs) #= (qX' #[[y ∧ x']]_xs)"
using qAbs_alphaAbs_iff[of xs x qX qA'] by auto
hence y_fresh: "qFresh xs y qX ∧ qFresh xs y qX'" using qAFresh_imp_qFresh by auto
have "(qX, qX #[[y ∧ x]]_xs) ∈ qSwapped" using qSwap_qSwapped by fastforce
hence "qInit MOD (qX #[[y ∧ x]]_xs) = qInit MOD (qX' #[[y ∧ x']]_xs)"
using Abs.IH alpha by simp
hence "igSwap MOD xs y x (qInit MOD qX) = igSwap MOD xs y x' (qInit MOD qX')"
using assms by(auto simp: iwlsFSwSTR_qSwapAll_igSwapAll_qInitAll)
moreover have "igFresh MOD xs y (qInit MOD qX) ∧ igFresh MOD xs y (qInit MOD qX')"
using y_fresh assms by(auto simp add: iwlsFSwSTR_qFreshAll_igFreshAll_qInitAll)
ultimately have "igAbs MOD xs x (qInit MOD qX) = igAbs MOD xs x' (qInit MOD qX')"
using y_not assms unfolding iwlsFSwSTR_def igAbsCongSSTR_def
apply clarify by (erule allE[of _ xs], erule allE[of _ x]) blast
thus "qInitAbs MOD (qAbs xs x qX) = qInitAbs MOD qA'" unfolding qA' by simp
qed
qed
corollary iwlsFSwSTR_qInit_respectsP_alpha:
assumes "iwlsFSwSTR MOD" shows "(qInit MOD) respectsP alpha"
unfolding congruentP_def using assms iwlsFSwSTR_alphaAll_qInitAll by blast
corollary iwlsFSwSTR_qInitAbs_respectsP_alphaAbs:
assumes "iwlsFSwSTR MOD" shows "(qInitAbs MOD) respectsP alphaAbs"
unfolding congruentP_def using assms iwlsFSwSTR_alphaAll_qInitAll by blast
lemma iwlsFSbSwTR_alphaAll_qInitAll:
fixes qX::"('index,'bindex,'varSort,'var,'opSym)qTerm" and
qA::"('index,'bindex,'varSort,'var,'opSym)qAbs"
assumes "iwlsFSbSwTR MOD"
shows
"(qGood qX ⟶ (∀ qX'. qX #= qX' ⟶ qInit MOD qX = qInit MOD qX')) ∧
(qGoodAbs qA ⟶ (∀ qA'. qA $= qA' ⟶ qInitAbs MOD qA = qInitAbs MOD qA'))"
proof(induction rule: qGood_qTerm_induct)
case (Var xs x)
then show ?case by(simp add: qVar_alpha_iff)
next
case (Op delta qinp qbinp)
show ?case proof safe
fix qX'
assume "qOp delta qinp qbinp #= qX'"
then obtain qinp' qbinp' where qX': "qX' = qOp delta qinp' qbinp'"
and *: "sameDom qinp qinp' ∧ sameDom qbinp qbinp'"
and **: "liftAll2 (λqX qX'. qX #= qX') qinp qinp' ∧
liftAll2 (λqA qA'. qA $= qA') qbinp qbinp'"
using qOp_alpha_iff[of delta qinp qbinp qX'] by auto
have "lift (qInit MOD) qinp = lift (qInit MOD) qinp'"
using "*" "**" Op.IH(1) by (simp add: lift_def liftAll2_def liftAll_def
sameDom_def fun_eq_iff split: option.splits) (metis option.exhaust)
moreover
have "lift (qInitAbs MOD) qbinp = lift (qInitAbs MOD) qbinp'"
using "*" "**" Op.IH(2) by (simp add: lift_def liftAll2_def liftAll_def
sameDom_def fun_eq_iff split: option.splits) (metis option.exhaust)
ultimately
show "qInit MOD (qOp delta qinp qbinp) = qInit MOD qX'"
unfolding qX' by simp
qed
next
case (Abs xs x qX)
show ?case proof safe
fix qA'
assume "qAbs xs x qX $= qA'"
then obtain x' y qX' where qA': "qA' = qAbs xs x' qX'"
and y_not: "y ∉ {x, x'}" and y_afresh: "qAFresh xs y qX" "qAFresh xs y qX'"
and alpha: "(qX #[[y ∧ x]]_xs) #= (qX' #[[y ∧ x']]_xs)"
using qAbs_alphaAbs_iff[of xs x qX qA'] by auto
hence y_fresh: "qFresh xs y qX ∧ qFresh xs y qX'" using qAFresh_imp_qFresh by auto
have qX': "qGood qX'" using alpha Abs by(simp add: alpha_qSwap_preserves_qGood1)
have "(qX, qX #[[y ∧ x]]_xs) ∈ qSwapped" using qSwap_qSwapped by fastforce
hence "qInit MOD (qX #[[y ∧ x]]_xs) = qInit MOD (qX' #[[y ∧ x']]_xs)"
using Abs.IH alpha by simp
moreover have "qInit MOD (qX #[[y ∧ x]]_xs) = igSubst MOD xs (igVar MOD xs y) x (qInit MOD qX)"
using Abs y_afresh assms by(simp add: iwlsFSbSwTR_qSwapAll_igSubstAll_qInitAll)
moreover have "qInit MOD (qX' #[[y ∧ x']]_xs) = igSubst MOD xs (igVar MOD xs y) x' (qInit MOD qX')"
using qX' y_afresh assms by(simp add: iwlsFSbSwTR_qSwapAll_igSubstAll_qInitAll)
ultimately
have "igSubst MOD xs (igVar MOD xs y) x (qInit MOD qX) =
igSubst MOD xs (igVar MOD xs y) x' (qInit MOD qX')"
by simp
moreover have "igFresh MOD xs y (qInit MOD qX) ∧ igFresh MOD xs y (qInit MOD qX')"
using y_fresh assms by(auto simp add: iwlsFSbSwTR_qFreshAll_igFreshAll_qInitAll)
moreover have "igAbsCongUSTR MOD"
using assms unfolding iwlsFSbSwTR_def using igAbsRenSTR_imp_igAbsCongUSTR by auto
ultimately have "igAbs MOD xs x (qInit MOD qX) = igAbs MOD xs x' (qInit MOD qX')"
using y_not unfolding igAbsCongUSTR_def apply clarify
by (erule allE[of _ xs], erule allE[of _ x]) blast
thus "qInitAbs MOD (qAbs xs x qX) = qInitAbs MOD qA'" unfolding qA' by simp
qed
qed
corollary iwlsFSbSwTR_qInit_respectsP_alphaGood:
assumes "iwlsFSbSwTR MOD"
shows "(qInit MOD) respectsP alphaGood"
unfolding congruentP_def alphaGood_def
using assms iwlsFSbSwTR_alphaAll_qInitAll by fastforce
corollary iwlsFSbSwTR_qInitAbs_respectsP_alphaAbsGood:
assumes "iwlsFSbSwTR MOD"
shows "(qInitAbs MOD) respectsP alphaAbsGood"
unfolding congruentP_def alphaAbsGood_def
using assms iwlsFSbSwTR_alphaAll_qInitAll by auto
subsubsection ‹The initial morphism (iteration map) from the term model to any strong model›
text ‹This morphism has the same definition for fresh-swap and fresh-subst strong models›
definition iterSTR where
"iterSTR MOD == univ (qInit MOD)"
definition iterAbsSTR where
"iterAbsSTR MOD == univ (qInitAbs MOD)"
lemma iwlsFSwSTR_iterSTR_ipresVar:
assumes "iwlsFSwSTR MOD"
shows "ipresVar (iterSTR MOD) MOD"
using assms by(simp add: ipresVar_def Var_def iterSTR_def iwlsFSwSTR_qInit_respectsP_alpha)
lemma iwlsFSbSwTR_iterSTR_ipresVar:
assumes "iwlsFSbSwTR MOD"
shows "ipresVar (iterSTR MOD) MOD"
using assms by (simp add: ipresVar_def Var_def iterSTR_def iwlsFSbSwTR_qInit_respectsP_alphaGood)
lemma iwlsFSwSTR_iterSTR_ipresAbs:
assumes "iwlsFSwSTR MOD"
shows "ipresAbs (iterSTR MOD) (iterAbsSTR MOD) MOD"
unfolding ipresAbs_def proof clarify
fix xs x s X assume X: "wls s X"
hence "qGood (pick X)" by(simp add: good_imp_qGood_pick)
hence 1: "qGoodAbs (qAbs xs x (pick X))" by simp
have "iterAbsSTR MOD (Abs xs x X) = univ (qInitAbs MOD) (asAbs (qAbs xs x (pick X)))"
using X unfolding Abs_def iterAbsSTR_def by simp
also have "… = qInitAbs MOD (qAbs xs x (pick X))"
using assms 1 by(simp add: iwlsFSwSTR_qInitAbs_respectsP_alphaAbs)
also have "… = igAbs MOD xs x (qInit MOD (pick X))" by simp
also have "… = igAbs MOD xs x (iterSTR MOD X)" unfolding iterSTR_def
unfolding univ_def pick_def ..
finally show "iterAbsSTR MOD (Abs xs x X) = igAbs MOD xs x (iterSTR MOD X)" .
qed
lemma iwlsFSbSwTR_iterSTR_ipresAbs:
assumes "iwlsFSbSwTR MOD"
shows "ipresAbs (iterSTR MOD) (iterAbsSTR MOD) MOD"
unfolding ipresAbs_def proof clarify
fix xs x s X assume X: "wls s X"
hence "qGood (pick X)" by(simp add: good_imp_qGood_pick)
hence 1: "qGoodAbs (qAbs xs x (pick X))" by simp
have "iterAbsSTR MOD (Abs xs x X) = univ (qInitAbs MOD) (asAbs (qAbs xs x (pick X)))"
using X unfolding Abs_def iterAbsSTR_def by simp
also have "… = qInitAbs MOD (qAbs xs x (pick X))"
using assms 1 by(simp add: iwlsFSbSwTR_qInitAbs_respectsP_alphaAbsGood)
also have "… = igAbs MOD xs x (qInit MOD (pick X))" by simp
also have "… = igAbs MOD xs x (iterSTR MOD X)" unfolding iterSTR_def univ_def
unfolding univ_def pick_def ..
finally show "iterAbsSTR MOD (Abs xs x X) = igAbs MOD xs x (iterSTR MOD X)" .
qed
lemma iwlsFSwSTR_iterSTR_ipresOp:
assumes "iwlsFSwSTR MOD"
shows "ipresOp (iterSTR MOD) (iterAbsSTR MOD) MOD"
unfolding ipresOp_def proof clarify
fix delta inp binp
assume inp: "wlsInp delta inp" "wlsBinp delta binp"
hence "qGoodInp (pickInp inp) ∧ qGoodBinp (pickBinp binp)"
by(simp add: goodInp_imp_qGoodInp_pickInp goodBinp_imp_qGoodBinp_pickBinp)
hence 1: "qGood (qOp delta (pickInp inp) (pickBinp binp))" by simp
have "iterSTR MOD (Op delta inp binp) =
univ (qInit MOD) (asTerm (qOp delta (pickInp inp) (pickBinp binp)))"
using inp unfolding Op_def iterSTR_def by simp
moreover have "… = qInit MOD (qOp delta (pickInp inp) (pickBinp binp))"
using assms 1 by(simp add: iwlsFSwSTR_qInit_respectsP_alpha)
moreover have "… = igOp MOD delta (lift (qInit MOD) (pickInp inp))
(lift (qInitAbs MOD) (pickBinp binp))" by auto
moreover
have "lift (qInit MOD) (pickInp inp) = lift (iterSTR MOD) inp ∧
lift (qInitAbs MOD) (pickBinp binp) = lift (iterAbsSTR MOD) binp"
unfolding pickInp_def pickBinp_def iterSTR_def iterAbsSTR_def
lift_comp univ_def[abs_def] comp_def
unfolding univ_def pick_def by simp
ultimately
show "iterSTR MOD (Op delta inp binp) =
igOp MOD delta (lift (iterSTR MOD) inp) (lift (iterAbsSTR MOD) binp)" by simp
qed
lemma iwlsFSbSwTR_iterSTR_ipresOp:
assumes "iwlsFSbSwTR MOD"
shows "ipresOp (iterSTR MOD) (iterAbsSTR MOD) MOD"
unfolding ipresOp_def proof clarify
fix delta inp binp
assume inp: "wlsInp delta inp" "wlsBinp delta binp"
hence "qGoodInp (pickInp inp) ∧ qGoodBinp (pickBinp binp)"
by(simp add: goodInp_imp_qGoodInp_pickInp goodBinp_imp_qGoodBinp_pickBinp)
hence 1: "qGood (qOp delta (pickInp inp) (pickBinp binp))" by simp
have "iterSTR MOD (Op delta inp binp) =
univ (qInit MOD) (asTerm (qOp delta (pickInp inp) (pickBinp binp)))"
using inp unfolding Op_def iterSTR_def by simp
moreover have "… = qInit MOD (qOp delta (pickInp inp) (pickBinp binp))"
using assms 1 by(simp add: iwlsFSbSwTR_qInit_respectsP_alphaGood)
moreover have "… = igOp MOD delta (lift (qInit MOD) (pickInp inp))
(lift (qInitAbs MOD) (pickBinp binp))" by simp
moreover have "lift (qInit MOD) (pickInp inp) = lift (iterSTR MOD) inp ∧
lift (qInitAbs MOD) (pickBinp binp) = lift (iterAbsSTR MOD) binp"
unfolding pickInp_def pickBinp_def iterSTR_def iterAbsSTR_def
lift_comp univ_def[abs_def] comp_def
unfolding univ_def pick_def by simp
ultimately
show "iterSTR MOD (Op delta inp binp) =
igOp MOD delta (lift (iterSTR MOD) inp) (lift (iterAbsSTR MOD) binp)" by simp
qed
lemma iwlsFSwSTR_iterSTR_ipresCons:
assumes "iwlsFSwSTR MOD"
shows "ipresCons (iterSTR MOD) (iterAbsSTR MOD) MOD"
unfolding ipresCons_def using assms
iwlsFSwSTR_iterSTR_ipresVar
iwlsFSwSTR_iterSTR_ipresAbs
iwlsFSwSTR_iterSTR_ipresOp by auto
lemma iwlsFSbSwTR_iterSTR_ipresCons:
assumes "iwlsFSbSwTR MOD"
shows "ipresCons (iterSTR MOD) (iterAbsSTR MOD) MOD"
unfolding ipresCons_def using assms
iwlsFSbSwTR_iterSTR_ipresVar
iwlsFSbSwTR_iterSTR_ipresAbs
iwlsFSbSwTR_iterSTR_ipresOp by auto
lemma iwlsFSwSTR_iterSTR_termFSwImorph:
assumes "iwlsFSwSTR MOD"
shows "termFSwImorph (iterSTR MOD) (iterAbsSTR MOD) MOD"
using assms by (auto simp: iwlsFSwSTR_termFSwImorph_iff intro: iwlsFSwSTR_iterSTR_ipresCons)
corollary iterSTR_termFSwImorph_errMOD:
assumes "iwlsFSw MOD"
shows
"termFSwImorph (iterSTR (errMOD MOD))
(iterAbsSTR (errMOD MOD))
(errMOD MOD)"
using assms errMOD_iwlsFSwSTR iwlsFSwSTR_iterSTR_termFSwImorph by auto
lemma iwlsFSbSwTR_iterSTR_termFSbImorph:
assumes "iwlsFSbSwTR MOD"
shows "termFSbImorph (iterSTR MOD) (iterAbsSTR MOD) MOD"
using assms by (auto simp: iwlsFSbSwTR_termFSbImorph_iff intro: iwlsFSbSwTR_iterSTR_ipresCons)
corollary iterSTR_termFSbImorph_errMOD:
assumes "iwlsFSb MOD"
shows
"termFSbImorph (iterSTR (errMOD MOD))
(iterAbsSTR (errMOD MOD))
(errMOD MOD)"
using assms errMOD_iwlsFSbSwTR iwlsFSbSwTR_iterSTR_termFSbImorph by auto
declare qItem_simps[simp del]
declare qItem_versus_item_simps[simp del]
declare good_item_simps[simp del]
subsubsection ‹The initial morhpism (iteration map) from the term model to any model›
text ‹Again, this morphism has the same definition for fresh-swap and fresh-subst models,
as well as (of course) for fresh-swap-subst and fresh-subst-swap models. (Remember that
there is no such thing as ``fresh-subst-swap" morhpism -- we use the notion of
``fresh-swap-subst" morphism.)›
text ‹Existence of the morphism:›
definition iter where
"iter MOD == check o (iterSTR (errMOD MOD))"
definition iterAbs where
"iterAbs MOD == check o (iterAbsSTR (errMOD MOD))"
theorem iwlsFSw_iterAll_termFSwImorph:
"iwlsFSw MOD ⟹ termFSwImorph (iter MOD) (iterAbs MOD) MOD"
using iterSTR_termFSwImorph_errMOD check_FSwImorph
by (auto simp: iter_def iterAbs_def intro: comp_termFSwImorph)
theorem iwlsFSb_iterAll_termFSbImorph:
"iwlsFSb MOD ⟹ termFSbImorph (iter MOD) (iterAbs MOD) MOD"
using iterSTR_termFSbImorph_errMOD check_FSbImorph
by (auto simp: iter_def iterAbs_def intro: comp_termFSbImorph)
theorem iwlsFSwSb_iterAll_termFSwSbImorph:
"iwlsFSwSb MOD ⟹ termFSwSbImorph (iter MOD) (iterAbs MOD) MOD"
using iwlsFSw_iterAll_termFSwImorph
by (auto simp: iwlsFSwSb_termFSwSbImorph_iff iwlsFSwSb_def termFSwImorph_def)
theorem iwlsFSbSw_iterAll_termFSwSbImorph:
"iwlsFSbSw MOD ⟹ termFSwSbImorph (iter MOD) (iterAbs MOD) MOD"
using iwlsFSb_iterAll_termFSbImorph
by (auto simp: iwlsFSbSw_termFSwSbImorph_iff iwlsFSbSw_def termFSbImorph_def)
text ‹Uniqueness of the morphism›
text ‹In fact, already a presumptive construct-preserving map has to be unique:›
lemma ipresCons_unique:
assumes "ipresCons f fA MOD" and "ipresCons ig igA MOD"
shows
"(wls s X ⟶ f X = ig X) ∧
(wlsAbs (us,s') A ⟶ fA A = igA A)"
proof(induction rule: wls_rawInduct)
case (Var xs x)
then show ?case using assms unfolding ipresCons_def ipresVar_def by simp
next
case (Op delta inp binp)
hence "lift f inp = lift ig inp ∧ lift fA binp = lift igA binp"
using assms
apply(simp add: lift_def liftAll2_def sameDom_def fun_eq_iff wlsInp_iff wlsBinp_iff split: option.splits)
using not_None_eq by (metis surj_pair)
thus "f (Op delta inp binp) = ig (Op delta inp binp)"
using assms unfolding ipresCons_def ipresOp_def by (simp add: Op.IH)
next
case (Abs s xs x X)
then show ?case using assms unfolding ipresCons_def ipresAbs_def apply clarify
by (erule allE[of _ xs], erule allE[of _ x]) fastforce
qed
theorem iwlsFSw_iterAll_unique_ipresCons:
assumes "iwlsFSw MOD" and "ipresCons h hA MOD"
shows
"(wls s X ⟶ h X = iter MOD X) ∧
(wlsAbs (us,s') A ⟶ hA A = iterAbs MOD A)"
using assms iwlsFSw_iterAll_termFSwImorph
by (auto simp: termFSwImorph_def intro!: ipresCons_unique)
theorem iwlsFSb_iterAll_unique_ipresCons:
assumes "iwlsFSb MOD" and "ipresCons h hA MOD"
shows
"(wls s X ⟶ h X = iter MOD X) ∧
(wlsAbs (us,s') A ⟶ hA A = iterAbs MOD A)"
using assms iwlsFSb_iterAll_termFSbImorph
by (auto simp: termFSbImorph_def intro!: ipresCons_unique)
theorem iwlsFSwSb_iterAll_unique_ipresCons:
assumes "iwlsFSwSb MOD" and "ipresCons h hA MOD"
shows
"(wls s X ⟶ h X = iter MOD X) ∧
(wlsAbs (us,s') A ⟶ hA A = iterAbs MOD A)"
using assms unfolding iwlsFSwSb_def
using iwlsFSw_iterAll_unique_ipresCons by blast
theorem iwlsFSbSw_iterAll_unique_ipresCons:
assumes *: "iwlsFSbSw MOD" and **: "ipresCons h hA MOD"
shows
"(wls s X ⟶ h X = iter MOD X) ∧
(wlsAbs (us,s') A ⟶ hA A = iterAbs MOD A)"
using assms unfolding iwlsFSbSw_def
using iwlsFSb_iterAll_unique_ipresCons by blast
lemmas iteration_simps =
input_igSwap_igSubst_None
termMOD_simps
error_model_simps
declare iteration_simps [simp del]
end
end
Theory Semantic_Domains
section ‹Interpretation of syntax in semantic domains›
theory Semantic_Domains imports Iteration
begin
text ‹In this section, we employ our iteration principle
to obtain interpretation of syntax in semantic domains via valuations.
A bonus from our Horn-theoretic approach is the built-in
commutation of the interpretation with substitution versus valuation update,
a property known in the literature as the ``substitution lemma".›
subsection ‹Semantic domains and valuations›
text‹
Semantic domains are for binding signatures
what algebras are for standard algebraic signatures. They fix carrier sets for each sort,
and interpret each operation symbol as an operation on these sets
%
\footnote{
To match the Isabelle type system, we model (as usual) the family of carrier sets as a
``well-sortedness" predicate taking sorts and semantic items from a given
(initially unsorted) universe into booleans,
and require the operations, considered on the unsorted universe, to preserve well-sortedness.
}
%
of corresponding arity, where:
%
\\- non-binding arguments
are treated as usual (first-order) arguments;
%
\\- binding arguments are treated as second-order (functional) arguments.
%
\footnote{
In other words, syntactic bindings are captured semantically as functional bindings.}
%
In particular, for the untyped and simply-typed $\lambda$-calculi,
the semantic domains become the well-known (set-theoretic) Henkin models.
We use terminology and notation according to our general methodology employed so far:
the inhabitants of semantic domains are referred to as ``semantic items";
we prefix the reference to semantic items with an ``s": sX, sA, etc.
This convention also applies to the operations on semantic domains: ``sAbs", ``sOp", etc.
We eventually show that the function spaces consisting of maps
from valuations to semantic items form models;
in other words,
these maps can be viewed as ``generalized items"; we use for them
term-like notations ``X", ``A", etc.
(as we did in the theory that dealt with iteration).
›
subsubsection ‹Definitions:›
datatype ('varSort,'sTerm)sAbs = sAbs 'varSort "'sTerm ⇒ 'sTerm"
record ('index,'bindex,'varSort,'sort,'opSym,'sTerm)semDom =
sWls :: "'sort ⇒ 'sTerm ⇒ bool"
sDummy :: "'sort ⇒ 'sTerm"
sOp :: "'opSym ⇒ ('index,'sTerm)input ⇒ ('bindex,('varSort,'sTerm)sAbs)input ⇒'sTerm"
text‹The type of valuations:›
type_synonym ('varSort,'var,'sTerm)val = "'varSort ⇒ 'var ⇒ 'sTerm"
context FixSyn
begin
fun sWlsAbs where
"sWlsAbs SEM (xs,s) (sAbs xs' sF) =
(isInBar (xs,s) ∧ xs = xs' ∧
(∀ sX. if sWls SEM (asSort xs) sX
then sWls SEM s (sF sX)
else sF sX = sDummy SEM s))"
definition sWlsInp where
"sWlsInp SEM delta sinp ≡
wlsOpS delta ∧ sameDom (arOf delta) sinp ∧ liftAll2 (sWls SEM) (arOf delta) sinp"
definition sWlsBinp where
"sWlsBinp SEM delta sbinp ≡
wlsOpS delta ∧ sameDom (barOf delta) sbinp ∧ liftAll2 (sWlsAbs SEM) (barOf delta) sbinp"
definition sWlsNE where
"sWlsNE SEM ≡
∀ s. ∃ sX. sWls SEM s sX"
definition sWlsDisj where
"sWlsDisj SEM ≡
∀ s s' sX. sWls SEM s sX ∧ sWls SEM s' sX ⟶ s = s'"
definition sOpPrSWls where
"sOpPrSWls SEM ≡
∀ delta sinp sbinp.
sWlsInp SEM delta sinp ∧ sWlsBinp SEM delta sbinp
⟶ sWls SEM (stOf delta) (sOp SEM delta sinp sbinp)"
text‹The notion of a ``well-sorted" (better read as ``well-structured")
semantic domain:
%
\footnote{
As usual in Isabelle, we first define the ``raw" version,
and then ``fix" it with a well-structuredness predicate.
}
%
›
definition wlsSEM where
"wlsSEM SEM ≡
sWlsNE SEM ∧ sWlsDisj SEM ∧ sOpPrSWls SEM"
text‹The preperties described in the next 4 definitions turn out to be
consequences of the well-structuredness of the semantic domain:›
definition sWlsAbsNE where
"sWlsAbsNE SEM ≡
∀ us s. isInBar (us,s) ⟶ (∃ sA. sWlsAbs SEM (us,s) sA)"
definition sWlsAbsDisj where
"sWlsAbsDisj SEM ≡
∀ us s us' s' sA.
isInBar (us,s) ∧ isInBar (us',s') ∧ sWlsAbs SEM (us,s) sA ∧ sWlsAbs SEM (us',s') sA
⟶ us = us' ∧ s = s'"
text‹The notion of two valuations being equal everywhere but on a given variable:›
definition eqBut where
"eqBut val val' xs x ≡
∀ ys y. (ys = xs ∧ y = x) ∨ val ys y = val' ys y"
definition updVal ::
"('varSort,'var,'sTerm)val ⇒
'var ⇒ 'sTerm ⇒ 'varSort ⇒
('varSort,'var,'sTerm)val" ("_ '(_ := _')'__" 200)
where
"(val (x := sX)_xs) ≡
λ ys y. (if ys = xs ∧ y = x then sX else val ys y)"
definition swapVal ::
"'varSort ⇒ 'var ⇒ 'var ⇒ ('varSort,'var,'sTerm)val ⇒
('varSort,'var,'sTerm)val"
where
"swapVal zs z1 z2 val ≡ λxs x. val xs (x @xs[z1 ∧ z2]_zs) "
abbreviation swapVal_abbrev ("_ ^[_ ∧ _]'__" 200) where
"val ^[z1 ∧ z2]_zs ≡ swapVal zs z1 z2 val"
definition sWlsVal where
"sWlsVal SEM val ≡
∀ ys y. sWls SEM (asSort ys) (val ys y)"
definition sWlsValNE ::
"('index,'bindex,'varSort,'sort,'opSym,'sTerm)semDom ⇒ 'var ⇒ bool"
where
"sWlsValNE SEM x ≡ ∃ (val :: ('varSort,'var,'sTerm)val). sWlsVal SEM val"
subsubsection ‹Basic facts›
lemma sWlsNE_imp_sWlsAbsNE:
assumes "sWlsNE SEM"
shows "sWlsAbsNE SEM"
unfolding sWlsAbsNE_def proof clarify
fix xs s
obtain sY where "sWls SEM s sY"
using assms unfolding sWlsNE_def by auto
moreover assume "isInBar (xs,s)"
ultimately
have "sWlsAbs SEM (xs,s) (sAbs xs (λsX. if sWls SEM (asSort xs) sX
then sY
else sDummy SEM s))" by simp
thus "∃sA. sWlsAbs SEM (xs,s) sA" by blast
qed
lemma sWlsDisj_imp_sWlsAbsDisj:
"sWlsDisj SEM ⟹ sWlsNE SEM ⟹ sWlsAbsDisj SEM"
by (simp add: sWlsAbsDisj_def sWlsNE_def sWlsDisj_def)
(smt prod.inject sAbs.inject sWlsAbs.elims(2))
lemma sWlsNE_imp_sWlsValNE:
"sWlsNE SEM ⟹ sWlsValNE SEM x"
by (auto simp: sWlsNE_def sWlsValNE_def sWlsVal_def
intro!: exI someI_ex[of "(λ sY. sWls SEM (asSort _) sY)"])
theorem updVal_simp[simp]:
"(val (x := sX)_xs) ys y = (if ys = xs ∧ y = x then sX else val ys y)"
unfolding updVal_def by simp
theorem updVal_over[simp]:
"((val (x := sX)_xs) (x := sX')_xs) = (val (x := sX')_xs)"
unfolding updVal_def by fastforce
theorem updVal_commute:
assumes "xs ≠ ys ∨ x ≠ y"
shows "((val (x := sX)_xs) (y := sY)_ys) = ((val (y := sY)_ys) (x := sX)_xs)"
using assms unfolding updVal_def by fastforce
theorem updVal_preserves_sWls[simp]:
assumes "sWls SEM (asSort xs) sX" and "sWlsVal SEM val"
shows "sWlsVal SEM (val (x := sX)_xs)"
using assms unfolding sWlsVal_def by auto
lemmas updVal_simps = updVal_simp updVal_over updVal_preserves_sWls
theorem swapVal_ident[simp]: "(val ^[x ∧ x]_xs) = val"
unfolding swapVal_def by auto
theorem swapVal_compose:
"((val ^[x ∧ y]_zs) ^[x' ∧ y']_zs') =
((val ^[x' @zs'[x ∧ y]_zs ∧ y' @zs'[x ∧ y]_zs]_zs') ^[x ∧ y]_zs)"
unfolding swapVal_def by (metis sw_compose)
theorem swapVal_commute:
"zs ≠ zs' ∨ {x,y} ∩ {x',y'} = {} ⟹
((val ^[x ∧ y]_zs) ^[x' ∧ y']_zs') = ((val ^[x' ∧ y']_zs') ^[x ∧ y]_zs)"
using swapVal_compose[of zs' x' y' zs x y val] by(simp add: sw_def)
lemma swapVal_involutive[simp]: "((val ^[x ∧ y]_zs) ^[x ∧ y]_zs) = val"
unfolding swapVal_def by auto
lemma swapVal_sym: "(val ^[x ∧ y]_zs) = (val ^[y ∧ x]_zs)"
unfolding swapVal_def by(auto simp add: sw_sym)
lemma swapVal_preserves_sWls1:
assumes "sWlsVal SEM val"
shows "sWlsVal SEM (val ^[z1 ∧ z2]_zs)"
using assms unfolding sWlsVal_def swapVal_def by simp
theorem swapVal_preserves_sWls[simp]:
"sWlsVal SEM (val ^[z1 ∧ z2]_zs) = sWlsVal SEM val"
using swapVal_preserves_sWls1[of _ _ zs z1 z2] by fastforce
lemmas swapVal_simps = swapVal_ident swapVal_involutive swapVal_preserves_sWls
lemma updVal_swapVal:
"((val (x := sX)_xs) ^[y1 ∧ y2]_ys) =
((val ^[y1 ∧ y2]_ys) ((x @xs[y1 ∧ y2]_ys) := sX)_xs)"
unfolding swapVal_def by fastforce
lemma updVal_preserves_eqBut:
assumes "eqBut val val' ys y"
shows "eqBut (val (x := sX)_xs) (val' (x := sX)_xs) ys y"
using assms unfolding eqBut_def updVal_def by auto
lemma updVal_eqBut_eq:
assumes "eqBut val val' ys y"
shows "(val (y := sY)_ys) = (val' (y := sY)_ys)"
using assms unfolding eqBut_def by fastforce
lemma swapVal_preserves_eqBut:
assumes "eqBut val val' xs x"
shows "eqBut (val ^[z1 ∧ z2]_zs) (val' ^[z1 ∧ z2]_zs) xs (x @xs[z1 ∧ z2]_zs)"
using assms unfolding eqBut_def swapVal_def by force
subsection ‹Interpretation maps›
text‹An interpretation map, of syntax in a semantic domain,
is the usual one w.r.t. valuations. Here we state its compostionality conditions
(including the ``substitution lemma"), and later we prove the existence of a map
satisfying these conditions.›
subsubsection ‹Definitions›
text ‹Below, prefix ``pr" means ``preserves".›
definition prWls where
"prWls g SEM ≡ ∀ s X val.
wls s X ∧ sWlsVal SEM val
⟶ sWls SEM s (g X val)"
definition prWlsAbs where
"prWlsAbs gA SEM ≡ ∀ us s A val.
wlsAbs (us,s) A ∧ sWlsVal SEM val
⟶ sWlsAbs SEM (us,s) (gA A val)"
definition prWlsAll where
"prWlsAll g gA SEM ≡ prWls g SEM ∧ prWlsAbs gA SEM"
definition prVar where
"prVar g SEM ≡ ∀ xs x val.
sWlsVal SEM val ⟶ g (Var xs x) val = val xs x"
definition prAbs where
"prAbs g gA SEM ≡ ∀ xs s x X val.
isInBar (xs,s) ∧ wls s X ∧ sWlsVal SEM val
⟶
gA (Abs xs x X) val =
sAbs xs (λsX. if sWls SEM (asSort xs) sX then g X (val (x := sX)_xs)
else sDummy SEM s)"
definition prOp where
"prOp g gA SEM ≡ ∀ delta inp binp val.
wlsInp delta inp ∧ wlsBinp delta binp ∧ sWlsVal SEM val
⟶
g (Op delta inp binp) val =
sOp SEM delta (lift (λX. g X val) inp)
(lift (λA. gA A val) binp)"
definition prCons where
"prCons g gA SEM ≡ prVar g SEM ∧ prAbs g gA SEM ∧ prOp g gA SEM"
definition prFresh where
"prFresh g SEM ≡ ∀ ys y s X val val'.
wls s X ∧ fresh ys y X ∧
sWlsVal SEM val ∧ sWlsVal SEM val' ∧ eqBut val val' ys y
⟶ g X val = g X val'"
definition prFreshAbs where
"prFreshAbs gA SEM ≡ ∀ ys y us s A val val'.
wlsAbs (us,s) A ∧ freshAbs ys y A ∧
sWlsVal SEM val ∧ sWlsVal SEM val' ∧ eqBut val val' ys y
⟶ gA A val = gA A val'"
definition prFreshAll where
"prFreshAll g gA SEM ≡ prFresh g SEM ∧ prFreshAbs gA SEM"
definition prSwap where
"prSwap g SEM ≡ ∀ zs z1 z2 s X val.
wls s X ∧ sWlsVal SEM val
⟶
g (X #[z1 ∧ z2]_zs) val =
g X (val ^[z1 ∧ z2]_zs)"
definition prSwapAbs where
"prSwapAbs gA SEM ≡ ∀ zs z1 z2 us s A val.
wlsAbs (us,s) A ∧ sWlsVal SEM val
⟶
gA (A $[z1 ∧ z2]_zs) val =
gA A (val ^[z1 ∧ z2]_zs)"
definition prSwapAll where
"prSwapAll g gA SEM ≡ prSwap g SEM ∧ prSwapAbs gA SEM"
definition prSubst where
"prSubst g SEM ≡ ∀ ys Y y s X val.
wls (asSort ys) Y ∧ wls s X
∧ sWlsVal SEM val
⟶
g (X #[Y / y]_ys) val =
g X (val (y := g Y val)_ys)"
definition prSubstAbs where
"prSubstAbs g gA SEM ≡ ∀ ys Y y us s A val.
wls (asSort ys) Y ∧ wlsAbs (us,s) A
∧ sWlsVal SEM val
⟶
gA (A $[Y / y]_ys) val =
gA A (val (y := g Y val)_ys)"
definition prSubstAll where
"prSubstAll g gA SEM ≡ prSubst g SEM ∧ prSubstAbs g gA SEM"
definition compInt where
"compInt g gA SEM ≡ prWlsAll g gA SEM ∧ prCons g gA SEM ∧
prFreshAll g gA SEM ∧ prSwapAll g gA SEM ∧ prSubstAll g gA SEM"
subsubsection ‹Extension of domain preservation to inputs›
lemma prWls_wlsInp:
assumes "wlsInp delta inp" and "prWls g SEM" and "sWlsVal SEM val"
shows "sWlsInp SEM delta (lift (λ X. g X val) inp)"
using assms unfolding sWlsInp_def wlsInp_iff liftAll2_def lift_def prWls_def
by (auto simp add: option.case_eq_if sameDom_def)
lemma prWlsAbs_wlsBinp:
assumes "wlsBinp delta binp" and "prWlsAbs gA SEM" and "sWlsVal SEM val"
shows "sWlsBinp SEM delta (lift (λ A. gA A val) binp)"
using assms unfolding sWlsBinp_def wlsBinp_iff liftAll2_def lift_def prWlsAbs_def
by (auto simp add: option.case_eq_if sameDom_def)
end
subsection ‹The iterative model associated to a semantic domain›
text‹
``asIMOD SEM" stands for ``SEM (regarded) as a model".
%
\footnote{
We use the word ``model" as introduced in the theory ``Models-and-Recursion".
}
%
The associated model is built essentially as follows:
%
\\- Its carrier sets consist of functions from valuations to semantic items.
%
\\- The construct operations (i.e., those corresponding to the syntactic constructs
indicated in the given binding signature) are lifted componentwise from those of the semantic domain
``SEM" (also taking into account the higher-order nature of of the semantic counterparts of abstractions).
%
\\- For a map from valuations to items (terms or abstractions), freshness of a variable ``x"
is defined as being oblivious what the argument valuation returns for ``x".
%
\\- Swapping is defined componentwise, by two iterations of the notion of swapping the
returned value of a function.
%
\\- Substitution of a semantic term ``Y" for a variable ``y" is a semantic term ``X"
is defined to map each valuation ``val" to the application of ``X" to
[``val" updated at ``y" with whatever ``Y" returns for ``val"].
Note that:
%
\\- The construct operations definitions are determined by the desired clauses of the standard
notion of interpreting syntax in a semantic domains.
%
\\- Substitution and freshness are defined having in mind the (again standard) facts of
the interpretation commuting with substitution versus valuation update and the interpretation
being oblivious to the valuation of fresh variables.
›
subsubsection ‹Definition and basic facts›
text‹
The next two types of ``generalized items" are used to build models from semantic domains:
%
\footnote{
Recall that ``generalized items" inhabit models.
}
%
›
type_synonym ('varSort,'var,'sTerm) gTerm = "('varSort,'var,'sTerm)val ⇒ 'sTerm"
type_synonym ('varSort,'var,'sTerm) gAbs = "('varSort,'var,'sTerm)val ⇒ ('varSort,'sTerm)sAbs"
context FixSyn
begin
definition asIMOD ::
"('index,'bindex,'varSort,'sort,'opSym,'sTerm)semDom ⇒
('index,'bindex,'varSort,'sort,'opSym,'var,
('varSort,'var,'sTerm)gTerm,
('varSort,'var,'sTerm)gAbs)model"
where
"asIMOD SEM ≡
⦇igWls = λs X. ∀ val. (sWlsVal SEM val ∨ X val = undefined) ∧
(sWlsVal SEM val ⟶ sWls SEM s (X val)),
igWlsAbs = λ(xs,s) A. ∀ val. (sWlsVal SEM val ∨ A val = undefined) ∧
(sWlsVal SEM val ⟶ sWlsAbs SEM (xs,s) (A val)),
igVar = λys y. λval. if sWlsVal SEM val then val ys y else undefined,
igAbs =
λxs x X. λval. if sWlsVal SEM val
then sAbs xs (λsX. if sWls SEM (asSort xs) sX
then X (val (x := sX)_xs)
else sDummy SEM (SOME s. sWls SEM s (X val)))
else undefined,
igOp = λdelta inp binp. λval.
if sWlsVal SEM val then sOp SEM delta (lift (λX. X val) inp)
(lift (λA. A val) binp)
else undefined,
igFresh =
λys y X. ∀ val val'. sWlsVal SEM val ∧ sWlsVal SEM val' ∧ eqBut val val' ys y
⟶ X val = X val',
igFreshAbs =
λys y A. ∀ val val'. sWlsVal SEM val ∧ sWlsVal SEM val' ∧ eqBut val val' ys y
⟶ A val = A val',
igSwap = λzs z1 z2 X. λval. if sWlsVal SEM val then X (val ^[z1 ∧ z2]_zs)
else undefined,
igSwapAbs = λzs z1 z2 A. λval. if sWlsVal SEM val then A (val ^[z1 ∧ z2]_zs)
else undefined,
igSubst = λys Y y X. λval. if sWlsVal SEM val then X (val (y := Y val)_ys)
else undefined,
igSubstAbs = λys Y y A. λval. if sWlsVal SEM val then A (val (y := Y val)_ys)
else undefined⦈"
text‹Next we state, as usual, the direct definitions of the operators and relations
of associated model, freeing ourselves from
having to go through the ``asIMOD" definition each time we reason about them.›
lemma asIMOD_igWls:
"igWls (asIMOD SEM) s X ⟷
(∀ val. (sWlsVal SEM val ∨ X val = undefined) ∧
(sWlsVal SEM val ⟶ sWls SEM s (X val)))"
unfolding asIMOD_def by simp
lemma asIMOD_igWlsAbs:
"igWlsAbs (asIMOD SEM) (us,s) A ⟷
(∀ val. (sWlsVal SEM val ∨ A val = undefined) ∧
(sWlsVal SEM val ⟶ sWlsAbs SEM (us,s) (A val)))"
unfolding asIMOD_def by simp
lemma asIMOD_igOp:
"igOp (asIMOD SEM) delta inp binp =
(λval. if sWlsVal SEM val then sOp SEM delta (lift (λX. X val) inp)
(lift (λA. A val) binp)
else undefined)"
unfolding asIMOD_def by simp
lemma asIMOD_igVar:
"igVar (asIMOD SEM) ys y = (λval. if sWlsVal SEM val then val ys y else undefined)"
unfolding asIMOD_def by simp
lemma asIMOD_igAbs:
"igAbs (asIMOD SEM) xs x X =
(λval. if sWlsVal SEM val then sAbs xs (λsX. if sWls SEM (asSort xs) sX
then X (val (x := sX)_xs)
else sDummy SEM (SOME s. sWls SEM s (X val)))
else undefined)"
unfolding asIMOD_def by simp
lemma asIMOD_igAbs2:
fixes SEM :: "('index,'bindex,'varSort,'sort,'opSym,'sTerm)semDom"
assumes *: "sWlsDisj SEM" and **: "igWls (asIMOD SEM) s X"
shows "igAbs (asIMOD SEM) xs x X =
(λval. if sWlsVal SEM val then sAbs xs (λsX. if sWls SEM (asSort xs) sX
then X (val (x := sX)_xs)
else sDummy SEM s)
else undefined)"
proof-
{fix val :: "('varSort,'var,'sTerm)val" assume val: "sWlsVal SEM val"
hence Xval: "sWls SEM s (X val)"
using ** unfolding asIMOD_igWls by simp
hence "(SOME s. sWls SEM s (X val)) = s"
using Xval * unfolding sWlsDisj_def by auto
}
thus ?thesis unfolding asIMOD_igAbs by fastforce
qed
lemma asIMOD_igFresh:
"igFresh (asIMOD SEM) ys y X =
(∀ val val'. sWlsVal SEM val ∧ sWlsVal SEM val' ∧ eqBut val val' ys y
⟶ X val = X val')"
unfolding asIMOD_def by simp
lemma asIMOD_igFreshAbs:
"igFreshAbs (asIMOD SEM) ys y A =
(∀ val val'. sWlsVal SEM val ∧ sWlsVal SEM val' ∧ eqBut val val' ys y
⟶ A val = A val')"
unfolding asIMOD_def by simp
lemma asIMOD_igSwap:
"igSwap (asIMOD SEM) zs z1 z2 X =
(λval. if sWlsVal SEM val then X (val ^[z1 ∧ z2]_zs) else undefined)"
unfolding asIMOD_def by simp
lemma asIMOD_igSwapAbs:
"igSwapAbs (asIMOD SEM) zs z1 z2 A =
(λval. if sWlsVal SEM val then A (val ^[z1 ∧ z2]_zs) else undefined)"
unfolding asIMOD_def by simp
lemma asIMOD_igSubst:
"igSubst (asIMOD SEM) ys Y y X =
(λval. if sWlsVal SEM val then X (val (y := Y val)_ys) else undefined)"
unfolding asIMOD_def by simp
lemma asIMOD_igSubstAbs:
"igSubstAbs (asIMOD SEM) ys Y y A =
(λval. if sWlsVal SEM val then A (val (y := Y val)_ys) else undefined)"
unfolding asIMOD_def by simp
lemma asIMOD_igWlsInp:
assumes "sWlsNE SEM"
shows
"igWlsInp (asIMOD SEM) delta inp ⟷
((∀ val. liftAll (λX. sWlsVal SEM val ∨ X val = undefined) inp) ∧
(∀ val. sWlsVal SEM val ⟶ sWlsInp SEM delta (lift (λX. X val) inp)))"
using assms apply safe
subgoal by (simp add: asIMOD_igWls liftAll_def liftAll2_def igWlsInp_def
sameDom_def split: option.splits) (metis option.distinct(1) option.exhaust)
subgoal by (simp add: igWlsInp_def asIMOD_igWls liftAll_def liftAll2_def
lift_def sWlsInp_def sameDom_def split: option.splits)
subgoal by (simp add:igWlsInp_def asIMOD_igWls liftAll_def liftAll2_def
lift_def sWlsInp_def sameDom_def split: option.splits)
(metis (no_types) option.distinct(1) sWlsNE_imp_sWlsValNE sWlsValNE_def) .
lemma asIMOD_igSwapInp:
"sWlsVal SEM val ⟹
lift (λX. X val) (igSwapInp (asIMOD SEM) zs z1 z2 inp) =
lift (λX. X (swapVal zs z1 z2 val)) inp"
by (auto simp: igSwapInp_def asIMOD_igSwap lift_def split: option.splits)
lemma asIMOD_igSubstInp:
"sWlsVal SEM val ⟹
lift (λX. X val) (igSubstInp (asIMOD SEM) ys Y y inp) =
lift (λX. X (val (y := Y val)_ys)) inp"
by (auto simp: igSubstInp_def asIMOD_igSubst lift_def split: option.splits)
lemma asIMOD_igWlsBinp:
assumes "sWlsNE SEM"
shows
"igWlsBinp (asIMOD SEM) delta binp =
((∀ val. liftAll (λX. sWlsVal SEM val ∨ X val = undefined) binp) ∧
(∀ val. sWlsVal SEM val ⟶ sWlsBinp SEM delta (lift (λX. X val) binp)))"
using assms apply safe
subgoal by (simp add: asIMOD_igWlsAbs liftAll_def liftAll2_def igWlsBinp_def
sameDom_def split: option.splits)
(metis option.distinct(1) option.exhaust surj_pair)
subgoal by (simp add: igWlsBinp_def asIMOD_igWlsAbs liftAll_def liftAll2_def
lift_def sWlsBinp_def sameDom_def split: option.splits)
subgoal by (simp add:igWlsBinp_def asIMOD_igWlsAbs liftAll_def liftAll2_def
lift_def sWlsBinp_def sameDom_def split: option.splits)
(metis (no_types) old.prod.exhaust option.distinct(1) option.exhaust
sWlsNE_imp_sWlsValNE sWlsValNE_def) .
lemma asIMOD_igSwapBinp:
"sWlsVal SEM val ⟹
lift (λA. A val) (igSwapBinp (asIMOD SEM) zs z1 z2 binp) =
lift (λA. A (swapVal zs z1 z2 val)) binp"
by (auto simp: igSwapBinp_def asIMOD_igSwapAbs lift_def split: option.splits)
lemma asIMOD_igSubstBinp:
"sWlsVal SEM val ⟹
lift (λA. A val) (igSubstBinp (asIMOD SEM) ys Y y binp) =
lift (λA. A (val (y := Y val)_ys)) binp"
by (auto simp: igSubstBinp_def asIMOD_igSubstAbs lift_def split: option.splits)
subsubsection ‹The associated model is well-structured›
text‹That is to say: it is a fresh-swap-subst
and fresh-subst-swap model (hence of course also a fresh-swap and fresh-subst) model.›
text‹Domain disjointness:›
lemma asIMOD_igWlsDisj:
"sWlsNE SEM ⟹ sWlsDisj SEM ⟹ igWlsDisj (asIMOD SEM)"
using sWlsNE_imp_sWlsValNE
by (fastforce simp: igWlsDisj_def asIMOD_igWls sWlsValNE_def sWlsDisj_def)
lemma asIMOD_igWlsAbsDisj:
"sWlsNE SEM ⟹ sWlsDisj SEM ⟹ igWlsAbsDisj (asIMOD SEM)"
using sWlsNE_imp_sWlsValNE sWlsDisj_imp_sWlsAbsDisj
by (fastforce simp: igWlsAbsDisj_def asIMOD_igWlsAbs sWlsAbsDisj_def sWlsValNE_def)
lemma asIMOD_igWlsAllDisj:
"sWlsNE SEM ⟹ sWlsDisj SEM ⟹ igWlsAllDisj (asIMOD SEM)"
unfolding igWlsAllDisj_def using asIMOD_igWlsDisj asIMOD_igWlsAbsDisj by auto
text ‹Only ``bound arit" abstraction domains are inhabited:›
lemma asIMOD_igWlsAbsIsInBar:
"sWlsNE SEM ⟹ igWlsAbsIsInBar (asIMOD SEM)"
using sWlsNE_imp_sWlsValNE
by (auto simp: sWlsValNE_def igWlsAbsIsInBar_def asIMOD_igWlsAbs
split: option.splits elim: sWlsAbs.elims(2))
text‹Domain preservation by the operators›
text‹The constructs preserve the domains:›
lemma asIMOD_igVarIPresIGWls: "igVarIPresIGWls (asIMOD SEM)"
unfolding igVarIPresIGWls_def asIMOD_igWls asIMOD_igVar sWlsVal_def by simp
lemma asIMOD_igAbsIPresIGWls:
"sWlsDisj SEM ⟹ igAbsIPresIGWls (asIMOD SEM)"
unfolding igAbsIPresIGWls_def asIMOD_igWlsAbs apply clarify
subgoal for _ _ _ _ val
unfolding asIMOD_igAbs2 by (cases "sWlsVal SEM val") (auto simp: asIMOD_igWls) .
lemma asIMOD_igOpIPresIGWls:
"sOpPrSWls SEM ⟹ sWlsNE SEM ⟹ igOpIPresIGWls (asIMOD SEM)"
using asIMOD_igWlsInp asIMOD_igWlsBinp
by (fastforce simp: igOpIPresIGWls_def asIMOD_igWls asIMOD_igOp sOpPrSWls_def)
lemma asIMOD_igConsIPresIGWls:
"wlsSEM SEM ⟹ igConsIPresIGWls (asIMOD SEM)"
unfolding igConsIPresIGWls_def wlsSEM_def
using asIMOD_igVarIPresIGWls asIMOD_igAbsIPresIGWls asIMOD_igOpIPresIGWls by auto
text‹Swap preserves the domains:›
lemma asIMOD_igSwapIPresIGWls: "igSwapIPresIGWls (asIMOD SEM)"
unfolding igSwapIPresIGWls_def asIMOD_igSwap asIMOD_igWls by auto
lemma asIMOD_igSwapAbsIPresIGWlsAbs: "igSwapAbsIPresIGWlsAbs (asIMOD SEM)"
unfolding igSwapAbsIPresIGWlsAbs_def asIMOD_igSwapAbs asIMOD_igWlsAbs by auto
lemma asIMOD_igSwapAllIPresIGWlsAll: "igSwapAllIPresIGWlsAll (asIMOD SEM)"
unfolding igSwapAllIPresIGWlsAll_def
using asIMOD_igSwapIPresIGWls asIMOD_igSwapAbsIPresIGWlsAbs by auto
text ‹Subst preserves the domains:›
lemma asIMOD_igSubstIPresIGWls: "igSubstIPresIGWls (asIMOD SEM)"
unfolding igSubstIPresIGWls_def asIMOD_igSubst asIMOD_igWls by simp
lemma asIMOD_igSubstAbsIPresIGWlsAbs: "igSubstAbsIPresIGWlsAbs (asIMOD SEM)"
unfolding igSubstAbsIPresIGWlsAbs_def asIMOD_igSubstAbs asIMOD_igWls asIMOD_igWlsAbs by simp
lemma asIMOD_igSubstAllIPresIGWlsAll: "igSubstAllIPresIGWlsAll (asIMOD SEM)"
unfolding igSubstAllIPresIGWlsAll_def
using asIMOD_igSubstIPresIGWls asIMOD_igSubstAbsIPresIGWlsAbs by auto
text ‹The clauses for fresh hold:›
lemma asIMOD_igFreshIGVar: "igFreshIGVar (asIMOD SEM)"
unfolding igFreshIGVar_def asIMOD_igFresh asIMOD_igVar eqBut_def by force
lemma asIMOD_igFreshIGAbs1:
"sWlsDisj SEM ⟹ igFreshIGAbs1 (asIMOD SEM)"
by(fastforce simp: igFreshIGAbs1_def asIMOD_igFresh asIMOD_igFreshAbs asIMOD_igAbs2 updVal_eqBut_eq)
lemma asIMOD_igFreshIGAbs2:
"sWlsDisj SEM ⟹ igFreshIGAbs2 (asIMOD SEM)"
by(fastforce simp: igFreshIGAbs2_def asIMOD_igFresh asIMOD_igFreshAbs asIMOD_igAbs2 updVal_preserves_eqBut)
lemma asIMOD_igFreshIGOp:
fixes SEM :: "('index,'bindex,'varSort,'sort,'opSym,'sTerm)semDom"
shows "igFreshIGOp (asIMOD SEM)"
unfolding igFreshIGOp_def proof clarify
fix ys y delta and inp :: "('index, ('varSort,'var,'sTerm)gTerm)input"
and binp :: "('bindex, ('varSort,'var,'sTerm)gAbs)input"
assume inp_fresh: "igFreshInp (asIMOD SEM) ys y inp"
"igFreshBinp (asIMOD SEM) ys y binp"
show "igFresh (asIMOD SEM) ys y (igOp (asIMOD SEM) delta inp binp)"
unfolding asIMOD_igFresh asIMOD_igOp proof safe
fix val val'
let ?sinp = "lift (λX. X val) inp" let ?sinp' = "lift (λX. X val') inp"
let ?sbinp = "lift (λA. A val) binp" let ?sbinp' = "lift (λA. A val') binp"
assume wls: "sWlsVal SEM val" "sWlsVal SEM val'" and "eqBut val val' ys y"
hence "?sinp = ?sinp' ∧ ?sbinp = ?sbinp'"
using inp_fresh
by (auto simp: lift_def igFreshInp_def igFreshBinp_def errMOD_def liftAll_def
asIMOD_igFresh asIMOD_igFreshAbs split: option.splits)
then show "(if sWlsVal SEM val then sOp SEM delta (lift (λX. X val) inp) (lift (λA. A val) binp)
else undefined) =
(if sWlsVal SEM val' then sOp SEM delta (lift (λX. X val') inp) (lift (λA. A val') binp)
else undefined)" using wls by auto
qed
qed
lemma asIMOD_igFreshCls:
assumes "sWlsDisj SEM"
shows "igFreshCls (asIMOD SEM)"
using assms unfolding igFreshCls_def
using asIMOD_igFreshIGVar asIMOD_igFreshIGAbs1 asIMOD_igFreshIGAbs2 asIMOD_igFreshIGOp by auto
text ‹The clauses for swap hold:›
lemma asIMOD_igSwapIGVar: "igSwapIGVar (asIMOD SEM)"
unfolding igSwapIGVar_def apply clarsimp apply(rule ext)
unfolding asIMOD_igSwap asIMOD_igVar apply clarsimp
unfolding swapVal_def by simp
lemma asIMOD_igSwapIGAbs: "igSwapIGAbs (asIMOD SEM)"
by (fastforce simp: igSwapIGAbs_def asIMOD_igSwap asIMOD_igSwapAbs asIMOD_igAbs updVal_swapVal)
lemma asIMOD_igSwapIGOp: "igSwapIGOp (asIMOD SEM)"
by (auto simp: igSwapIGOp_def asIMOD_igSwap asIMOD_igOp asIMOD_igSwapInp asIMOD_igSwapBinp)
lemma asIMOD_igSwapCls: "igSwapCls (asIMOD SEM)"
unfolding igSwapCls_def using asIMOD_igSwapIGVar asIMOD_igSwapIGAbs asIMOD_igSwapIGOp by auto
text‹The clauses for subst hold:›
lemma asIMOD_igSubstIGVar1: "igSubstIGVar1 (asIMOD SEM)"
by (auto simp: igSubstIGVar1_def asIMOD_igSubst asIMOD_igVar asIMOD_igWls)
lemma asIMOD_igSubstIGVar2: "igSubstIGVar2 (asIMOD SEM)"
by (fastforce simp: igSubstIGVar2_def asIMOD_igSubst asIMOD_igVar asIMOD_igWls)
lemma asIMOD_igSubstIGAbs: "igSubstIGAbs (asIMOD SEM)"
unfolding igSubstIGAbs_def proof(clarify, rule ext)
fix ys y Y xs x s X val
assume Y: "igWls (asIMOD SEM) (asSort ys) Y"
and X: "igWls (asIMOD SEM) s X" and x_diff_y: "xs ≠ ys ∨ x ≠ y"
and x_fresh_Y: "igFresh (asIMOD SEM) xs x Y"
show "igSubstAbs (asIMOD SEM) ys Y y (igAbs (asIMOD SEM) xs x X) val =
igAbs (asIMOD SEM) xs x (igSubst (asIMOD SEM) ys Y y X) val"
proof(cases "sWlsVal SEM val")
case False
thus ?thesis unfolding asIMOD_igSubst asIMOD_igSubstAbs asIMOD_igAbs by simp
next
case True
hence Yval: "sWls SEM (asSort ys) (Y val)"
using Y unfolding asIMOD_igWls by simp
{fix sX assume sX: "sWls SEM (asSort xs) sX"
let ?val_x = "val (x := sX)_xs"
have "sWlsVal SEM ?val_x" using True sX by simp
moreover have "eqBut ?val_x val xs x"
unfolding eqBut_def updVal_def by simp
ultimately have 1: "Y ?val_x = Y val"
using True x_fresh_Y unfolding asIMOD_igFresh by simp
let ?Left = "X ((val (y := Y val)_ys) (x := sX)_xs)"
let ?Riight = "X (?val_x (y := Y ?val_x)_ys)"
have "?Left = X (?val_x (y := Y val)_ys)"
using x_diff_y by(auto simp add: updVal_commute)
also have "… = ?Riight" using 1 by simp
finally have "?Left = ?Riight" .
}
thus ?thesis using True Yval by(auto simp: asIMOD_igSubst asIMOD_igSubstAbs asIMOD_igAbs)
qed
qed
lemma asIMOD_igSubstIGOp: "igSubstIGOp (asIMOD SEM)"
unfolding igSubstIGOp_def proof(clarify,rule ext)
fix ys y Y delta inp binp val
assume Y: "igWls (asIMOD SEM) (asSort ys) Y"
and inp: "igWlsInp (asIMOD SEM) delta inp"
and binp: "igWlsBinp (asIMOD SEM) delta binp"
define inpsb binpsb where
inpsb_def: "inpsb ≡ igSubstInp (asIMOD SEM) ys Y y inp"
"binpsb ≡ igSubstBinp (asIMOD SEM) ys Y y binp"
note inpsb_rev = inpsb_def[symmetric]
let ?sinpsb = "lift (λX. X (val (y := Y val)_ys)) inp"
let ?sbinpsb = "lift (λA. A (val (y := Y val)_ys)) binp"
show "igSubst (asIMOD SEM) ys Y y (igOp (asIMOD SEM) delta inp binp) val =
igOp (asIMOD SEM) delta (igSubstInp (asIMOD SEM) ys Y y inp)
(igSubstBinp (asIMOD SEM) ys Y y binp) val"
unfolding inpsb_rev unfolding asIMOD_igSubst asIMOD_igOp unfolding inpsb_def
apply(simp add: asIMOD_igSubstInp asIMOD_igSubstBinp)
using Y unfolding asIMOD_def by auto
qed
lemma asIMOD_igSubstCls: "igSubstCls (asIMOD SEM)"
unfolding igSubstCls_def
using asIMOD_igSubstIGVar1 asIMOD_igSubstIGVar2 asIMOD_igSubstIGAbs asIMOD_igSubstIGOp by auto
text ‹The fresh-swap-based congruence clause holds:›
lemma updVal_swapVal_eqBut: "eqBut (val (x := sX)_xs) ((val (y := sX)_xs) ^[y ∧ x]_xs) xs y"
by (simp add: updVal_def swapVal_def eqBut_def sw_def)
lemma asIMOD_igAbsCongS: "sWlsDisj SEM ⟹ igAbsCongS (asIMOD SEM)"
unfolding igAbsCongS_def asIMOD_igFresh asIMOD_igSwap asIMOD_igAbs2
apply safe apply (simp add: asIMOD_igAbs2)
by (rule ext) (metis (hide_lams) updVal_swapVal_eqBut swapVal_preserves_sWls updVal_preserves_sWls)
text ‹The abstraction-renaming clause holds:›
lemma asIMOD_igAbs3:
assumes "sWlsDisj SEM" and "igWls (asIMOD SEM) s X"
shows
"igAbs (asIMOD SEM) xs y (igSubst (asIMOD SEM) xs (igVar (asIMOD SEM) xs y) x X) =
(λval. if sWlsVal SEM val
then sAbs xs (λsX. if sWls SEM (asSort xs) sX
then (igSubst (asIMOD SEM) xs (igVar (asIMOD SEM) xs y) x X) (val (y := sX)_xs)
else sDummy SEM s)
else undefined)"
using assms asIMOD_igVarIPresIGWls asIMOD_igSubstIPresIGWls
unfolding igVarIPresIGWls_def igSubstIPresIGWls_def
by (fastforce intro!: asIMOD_igAbs2)
lemma asIMOD_igAbsRen:
"sWlsDisj SEM ⟹ igAbsRen (asIMOD SEM)"
unfolding igAbsRen_def asIMOD_igFresh asIMOD_igSwap apply safe
by (simp add: asIMOD_igAbs2 asIMOD_igAbs3)
(auto intro!: ext simp: asIMOD_igAbs2 asIMOD_igAbs3 eqBut_def asIMOD_igSubst asIMOD_igVar)
text ‹The associated model forms well-structured models of all 4 kinds:›
lemma asIMOD_wlsFSw:
assumes "wlsSEM SEM"
shows "iwlsFSw (asIMOD SEM)"
using assms unfolding wlsSEM_def iwlsFSw_def
using assms asIMOD_igWlsAllDisj asIMOD_igWlsAbsIsInBar
asIMOD_igConsIPresIGWls asIMOD_igSwapAllIPresIGWlsAll
asIMOD_igFreshCls asIMOD_igSwapCls asIMOD_igAbsCongS
by auto
lemma asIMOD_wlsFSb:
assumes "wlsSEM SEM"
shows "iwlsFSb (asIMOD SEM)"
using assms unfolding wlsSEM_def iwlsFSb_def
using assms asIMOD_igWlsAllDisj asIMOD_igWlsAbsIsInBar
asIMOD_igConsIPresIGWls[of SEM] asIMOD_igSubstAllIPresIGWlsAll
asIMOD_igFreshCls asIMOD_igSubstCls asIMOD_igAbsRen
by auto
lemma asIMOD_wlsFSwSb: "wlsSEM SEM ⟹ iwlsFSwSb (asIMOD SEM)"
unfolding iwlsFSwSb_def
using asIMOD_wlsFSw asIMOD_igSubstAllIPresIGWlsAll asIMOD_igSubstCls by auto
lemma asIMOD_wlsFSbSw: "wlsSEM SEM ⟹ iwlsFSbSw (asIMOD SEM)"
unfolding iwlsFSbSw_def
using asIMOD_wlsFSb asIMOD_igSwapAllIPresIGWlsAll asIMOD_igSwapCls by auto
subsection ‹The semantic interpretation›
text‹The well-definedness of the semantic interpretation, as well
as its associated substitution lemma and non-dependence of fresh variables,
are the end products of this theory.
Note that in order to establish these results either fresh-subst-swap or
fresh-swap-subst aligebras would do the job, and, moreover, if we did not care
about swapping, fresh-subst aligebras would do the job. Therefore, our
exhaustive study of the model from previous section had a deigree of redundancy w.r.t. to our main
igoal -- we pursued it however in order to better illustrate the rich structure laying under
the apparent paucity of the notion of a semantic domain. Next, we choose to employ
fresh-subst-swap aligebras to establish the required results. (Recall however that either aligebraic route
we take, the initial morphism turns out to be the same function.)›
definition semInt where "semInt SEM ≡ iter (asIMOD SEM)"
definition semIntAbs where "semIntAbs SEM ≡ iterAbs (asIMOD SEM)"
lemma semIntAll_termFSwSbImorph:
"wlsSEM SEM ⟹
termFSwSbImorph (semInt SEM) (semIntAbs SEM) (asIMOD SEM)"
unfolding semInt_def semInt_def semIntAbs_def
using asIMOD_wlsFSbSw iwlsFSbSw_iterAll_termFSwSbImorph by auto
lemma semInt_prWls:
"wlsSEM SEM ⟹ prWls (semInt SEM) SEM"
unfolding prWls_def using semIntAll_termFSwSbImorph
unfolding termFSwSbImorph_def termFSwImorph_def ipresWlsAll_def ipresWls_def asIMOD_igWls by auto
lemma semIntAbs_prWlsAbs:
"wlsSEM SEM ⟹ prWlsAbs (semIntAbs SEM) SEM"
unfolding prWlsAbs_def using semIntAll_termFSwSbImorph
unfolding termFSwSbImorph_def termFSwImorph_def ipresWlsAll_def ipresWlsAbs_def asIMOD_igWlsAbs by blast
lemma semIntAll_prWlsAll:
"wlsSEM SEM ⟹ prWlsAll (semInt SEM) (semIntAbs SEM) SEM"
unfolding prWlsAll_def by(simp add: semInt_prWls semIntAbs_prWlsAbs)
lemma semInt_prVar:
"wlsSEM SEM ⟹ prVar (semInt SEM) SEM"
using semIntAll_termFSwSbImorph
unfolding prVar_def termFSwSbImorph_def termFSwImorph_def ipresCons_def ipresVar_def asIMOD_igVar
by fastforce
lemma semIntAll_prAbs:
fixes SEM :: "('index,'bindex,'varSort,'sort,'opSym,'sTerm)semDom"
assumes "wlsSEM SEM"
shows "prAbs (semInt SEM) (semIntAbs SEM) SEM"
proof-
{fix xs s x X and val :: "('varSort,'var,'sTerm)val"
assume xs_s: "isInBar (xs,s)" and X: "wls s X"
and val: "sWlsVal SEM val"
let ?L = "semIntAbs SEM (Abs xs x X)"
let ?R = "λ val. sAbs xs (λsX. if sWls SEM (asSort xs) sX
then semInt SEM X (val (x := sX)_xs)
else sDummy SEM s)"
have "?L = igAbs (asIMOD SEM) xs x (semInt SEM X)"
using xs_s X assms semIntAll_termFSwSbImorph[of SEM]
unfolding termFSwSbImorph_def termFSwImorph_def ipresCons_def ipresAbs_def by auto
moreover
{have "prWls (semInt SEM) SEM" using assms semInt_prWls by auto
hence 1: "sWls SEM s (semInt SEM X val)"
using val X unfolding prWls_def by simp
hence "(SOME s. sWls SEM s (semInt SEM X val)) = s"
using 1 assms unfolding wlsSEM_def sWlsDisj_def by auto
hence "igAbs (asIMOD SEM) xs x (semInt SEM X) val = ?R val"
unfolding asIMOD_igAbs using val by fastforce
}
ultimately have "?L val = ?R val" by simp
}
thus ?thesis unfolding prAbs_def by auto
qed
lemma semIntAll_prOp:
assumes "wlsSEM SEM"
shows "prOp (semInt SEM) (semIntAbs SEM) SEM"
using assms semIntAll_termFSwSbImorph
unfolding prOp_def termFSwSbImorph_def termFSwImorph_def ipresCons_def ipresOp_def
asIMOD_igOp lift_comp comp_def by fastforce
lemma semIntAll_prCons:
assumes "wlsSEM SEM"
shows "prCons (semInt SEM) (semIntAbs SEM) SEM"
using assms unfolding prCons_def by(simp add: semInt_prVar semIntAll_prAbs semIntAll_prOp)
lemma semInt_prFresh:
assumes "wlsSEM SEM"
shows "prFresh (semInt SEM) SEM"
using assms semIntAll_termFSwSbImorph
unfolding prFresh_def termFSwSbImorph_def termFSwImorph_def ipresFreshAll_def ipresFresh_def
asIMOD_igFresh by fastforce
lemma semIntAbs_prFreshAbs:
assumes "wlsSEM SEM"
shows "prFreshAbs (semIntAbs SEM) SEM"
using assms semIntAll_termFSwSbImorph
unfolding prFreshAbs_def termFSwSbImorph_def termFSwImorph_def ipresFreshAll_def ipresFreshAbs_def
asIMOD_igFreshAbs by fastforce
lemma semIntAll_prFreshAll:
assumes "wlsSEM SEM"
shows "prFreshAll (semInt SEM) (semIntAbs SEM) SEM"
using assms unfolding prFreshAll_def by(simp add: semInt_prFresh semIntAbs_prFreshAbs)
lemma semInt_prSwap:
assumes "wlsSEM SEM"
shows "prSwap (semInt SEM) SEM"
using assms semIntAll_termFSwSbImorph
unfolding prSwap_def termFSwSbImorph_def termFSwImorph_def ipresSwapAll_def ipresSwap_def
asIMOD_igSwap by fastforce
lemma semIntAbs_prSwapAbs:
assumes "wlsSEM SEM"
shows "prSwapAbs (semIntAbs SEM) SEM"
using assms semIntAll_termFSwSbImorph
unfolding prSwapAbs_def termFSwSbImorph_def termFSwImorph_def ipresSwapAll_def ipresSwapAbs_def
asIMOD_igSwapAbs by fastforce
lemma semIntAll_prSwapAll:
assumes "wlsSEM SEM"
shows "prSwapAll (semInt SEM) (semIntAbs SEM) SEM"
using assms unfolding prSwapAll_def by(simp add: semInt_prSwap semIntAbs_prSwapAbs)
lemma semInt_prSubst:
assumes "wlsSEM SEM"
shows "prSubst (semInt SEM) SEM"
using assms semIntAll_termFSwSbImorph
unfolding prSubst_def termFSwSbImorph_def termFSwImorph_def ipresSubstAll_def ipresSubst_def
asIMOD_igSubst by fastforce
lemma semIntAbs_prSubstAbs:
assumes "wlsSEM SEM"
shows "prSubstAbs (semInt SEM) (semIntAbs SEM) SEM"
using assms semIntAll_termFSwSbImorph
unfolding prSubstAbs_def termFSwSbImorph_def termFSwImorph_def ipresSubstAll_def ipresSubstAbs_def
asIMOD_igSubstAbs by fastforce
lemma semIntAll_prSubstAll:
assumes "wlsSEM SEM"
shows "prSubstAll (semInt SEM) (semIntAbs SEM) SEM"
using assms unfolding prSubstAll_def by(simp add: semInt_prSubst semIntAbs_prSubstAbs)
theorem semIntAll_compInt:
assumes "wlsSEM SEM"
shows "compInt (semInt SEM) (semIntAbs SEM) SEM"
using assms unfolding compInt_def
by(simp add: semIntAll_prWlsAll semIntAll_prCons
semIntAll_prFreshAll semIntAll_prSwapAll semIntAll_prSubstAll)
lemmas semDom_simps = updVal_simps swapVal_simps
end
end
Theory Recursion
section ‹General Recursion›
theory Recursion imports Iteration
begin
text‹The initiality theorems from the previous section support iteration principles.
Next we extend the results to general recursion. The difference between
general recursion and iteration is that the former also considers
the (source) ``items" (terms and abstractions), and not only the
(target) generalized items, appear in the recursive clauses.
(Here is an example illustrating the above difference for the standard case
of natural numbers:
\\- Given a number n, the operator ``add-n" can be defined by iteration:
\\--- ``add-n 0 = n",
\\--- ``add-n (Suc m) = Suc (add-n m)".
Notice that, in right-hand side of the recursive clause, ``m" is not used ``directly", but only
via ``add-n" -- this makes the definition iterative. By contrast, the following
definition of predecessor is trivial form of recursion (namely, case analysis),
but is {\em not} iteration:
\\--- ``pred 0 = 0",
\\--- ``pred (Suc n) = n".
)
We achieve our desired extension by augmenting the notion of model
and then essentially inferring recursion (as customary)
from
[iteration having as target the product between the term model and the original model].
As a matter of notation: remember we are using for generalized items
the same meta-variables as for ``items" (terms and abstractions).
But now the model operators will take both items and generalized items.
We shall prime the meta-variables for items (as in X', A', etc).
›
subsection ‹Raw models›
record ('index,'bindex,'varSort,'sort,'opSym,'var,'gTerm,'gAbs)model =
gWls :: "'sort ⇒ 'gTerm ⇒ bool"
gWlsAbs :: "'varSort × 'sort ⇒ 'gAbs ⇒ bool"
gVar :: "'varSort ⇒ 'var ⇒ 'gTerm"
gAbs ::
"'varSort ⇒ 'var ⇒
('index,'bindex,'varSort,'var,'opSym)term ⇒ 'gTerm ⇒
'gAbs"
gOp ::
"'opSym ⇒
('index,('index,'bindex,'varSort,'var,'opSym)term)input ⇒ ('index,'gTerm)input ⇒
('bindex,('index,'bindex,'varSort,'var,'opSym)abs)input ⇒ ('bindex,'gAbs)input ⇒
'gTerm"
gFresh ::
"'varSort ⇒ 'var ⇒ ('index,'bindex,'varSort,'var,'opSym)term ⇒ 'gTerm ⇒ bool"
gFreshAbs ::
"'varSort ⇒ 'var ⇒ ('index,'bindex,'varSort,'var,'opSym)abs ⇒ 'gAbs ⇒ bool"
gSwap ::
"'varSort ⇒ 'var ⇒ 'var ⇒
('index,'bindex,'varSort,'var,'opSym)term ⇒ 'gTerm ⇒
'gTerm"
gSwapAbs ::
"'varSort ⇒ 'var ⇒ 'var ⇒
('index,'bindex,'varSort,'var,'opSym)abs ⇒ 'gAbs ⇒
'gAbs"
gSubst ::
"'varSort ⇒
('index,'bindex,'varSort,'var,'opSym)term ⇒ 'gTerm ⇒
'var ⇒
('index,'bindex,'varSort,'var,'opSym)term ⇒ 'gTerm ⇒
'gTerm"
gSubstAbs ::
"'varSort ⇒
('index,'bindex,'varSort,'var,'opSym)term ⇒ 'gTerm ⇒
'var ⇒
('index,'bindex,'varSort,'var,'opSym)abs ⇒ 'gAbs ⇒
'gAbs"
subsection ‹Well-sorted models of various kinds›
text‹Lifting the model operations to inputs›
definition gFreshInp where
"gFreshInp MOD ys y inp' inp ≡ liftAll2 (gFresh MOD ys y) inp' inp"
definition gFreshBinp where
"gFreshBinp MOD ys y binp' binp ≡ liftAll2 (gFreshAbs MOD ys y) binp' binp"
definition gSwapInp where
"gSwapInp MOD zs z1 z2 inp' inp ≡ lift2 (gSwap MOD zs z1 z2) inp' inp"
definition gSwapBinp where
"gSwapBinp MOD zs z1 z2 binp' binp ≡ lift2 (gSwapAbs MOD zs z1 z2) binp' binp"
definition gSubstInp where
"gSubstInp MOD ys Y' Y y inp' inp ≡ lift2 (gSubst MOD ys Y' Y y) inp' inp"
definition gSubstBinp where
"gSubstBinp MOD ys Y' Y y binp' binp ≡ lift2 (gSubstAbs MOD ys Y' Y y) binp' binp"
context FixSyn
begin
definition gWlsInp where
"gWlsInp MOD delta inp ≡
wlsOpS delta ∧ sameDom (arOf delta) inp ∧ liftAll2 (gWls MOD) (arOf delta) inp"
lemmas gWlsInp_defs = gWlsInp_def sameDom_def liftAll2_def
definition gWlsBinp where
"gWlsBinp MOD delta binp ≡
wlsOpS delta ∧ sameDom (barOf delta) binp ∧ liftAll2 (gWlsAbs MOD) (barOf delta) binp"
lemmas gWlsBinp_defs = gWlsBinp_def sameDom_def liftAll2_def
text‹Basic properties of the lifted model operations›
text‹. for free inputs:›
lemma sameDom_swapInp_gSwapInp[simp]:
assumes "wlsInp delta inp'" and "gWlsInp MOD delta inp"
shows "sameDom (swapInp zs z1 z2 inp') (gSwapInp MOD zs z1 z2 inp' inp)"
using assms by(simp add: wlsInp_iff gWlsInp_def swapInp_def gSwapInp_def
liftAll2_def lift_def lift2_def sameDom_def split: option.splits)
lemma sameDom_substInp_gSubstInp[simp]:
assumes "wlsInp delta inp'" and "gWlsInp MOD delta inp"
shows "sameDom (substInp ys Y' y inp') (gSubstInp MOD ys Y' Y y inp' inp)"
using assms by(simp add: wlsInp_iff gWlsInp_def substInp_def2 gSubstInp_def
liftAll2_def lift_def lift2_def sameDom_def split: option.splits)
text‹. for bound inputs:›
lemma sameDom_swapBinp_gSwapBinp[simp]:
assumes "wlsBinp delta binp'" and "gWlsBinp MOD delta binp"
shows "sameDom (swapBinp zs z1 z2 binp') (gSwapBinp MOD zs z1 z2 binp' binp)"
using assms by(simp add: wlsBinp_iff gWlsBinp_def swapBinp_def gSwapBinp_def
liftAll2_def lift_def lift2_def sameDom_def split: option.splits)
lemma sameDom_substBinp_gSubstBinp[simp]:
assumes "wlsBinp delta binp'" and "gWlsBinp MOD delta binp"
shows "sameDom (substBinp ys Y' y binp') (gSubstBinp MOD ys Y' Y y binp' binp)"
using assms by(simp add: wlsBinp_iff gWlsBinp_def substBinp_def2 gSubstBinp_def
liftAll2_def lift_def lift2_def sameDom_def split: option.splits)
lemmas sameDom_gInput_simps =
sameDom_swapInp_gSwapInp sameDom_substInp_gSubstInp
sameDom_swapBinp_gSwapBinp sameDom_substBinp_gSubstBinp
text‹Domain disjointness:›
definition gWlsDisj where
"gWlsDisj MOD ≡ ∀ s s' X. gWls MOD s X ∧ gWls MOD s' X ⟶ s = s'"
definition gWlsAbsDisj where
"gWlsAbsDisj MOD ≡ ∀ xs s xs' s' A.
isInBar (xs,s) ∧ isInBar (xs',s') ∧
gWlsAbs MOD (xs,s) A ∧ gWlsAbs MOD (xs',s') A
⟶ xs = xs' ∧ s = s'"
definition gWlsAllDisj where
"gWlsAllDisj MOD ≡ gWlsDisj MOD ∧ gWlsAbsDisj MOD"
lemmas gWlsAllDisj_defs =
gWlsAllDisj_def gWlsDisj_def gWlsAbsDisj_def
text ‹Abstraction domains inhabited only within bound arities:›
definition gWlsAbsIsInBar where
"gWlsAbsIsInBar MOD ≡ ∀ us s A. gWlsAbs MOD (us,s) A ⟶ isInBar (us,s)"
text‹Domain preservation by the operators›
text‹The constructs preserve the domains:›
definition gVarPresGWls where
"gVarPresGWls MOD ≡ ∀ xs x. gWls MOD (asSort xs) (gVar MOD xs x)"
definition gAbsPresGWls where
"gAbsPresGWls MOD ≡ ∀ xs s x X' X.
isInBar (xs,s) ∧ wls s X' ∧ gWls MOD s X ⟶
gWlsAbs MOD (xs,s) (gAbs MOD xs x X' X)"
definition gOpPresGWls where
"gOpPresGWls MOD ≡ ∀ delta inp' inp binp' binp.
wlsInp delta inp' ∧ gWlsInp MOD delta inp ∧ wlsBinp delta binp' ∧ gWlsBinp MOD delta binp
⟶ gWls MOD (stOf delta) (gOp MOD delta inp' inp binp' binp)"
definition gConsPresGWls where
"gConsPresGWls MOD ≡ gVarPresGWls MOD ∧ gAbsPresGWls MOD ∧ gOpPresGWls MOD"
lemmas gConsPresGWls_defs = gConsPresGWls_def
gVarPresGWls_def gAbsPresGWls_def gOpPresGWls_def
text‹``swap" preserves the domains:›
definition gSwapPresGWls where
"gSwapPresGWls MOD ≡ ∀ zs z1 z2 s X' X.
wls s X' ∧ gWls MOD s X ⟶
gWls MOD s (gSwap MOD zs z1 z2 X' X)"
definition gSwapAbsPresGWlsAbs where
"gSwapAbsPresGWlsAbs MOD ≡ ∀ zs z1 z2 us s A' A.
isInBar (us,s) ∧ wlsAbs (us,s) A' ∧ gWlsAbs MOD (us,s) A ⟶
gWlsAbs MOD (us,s) (gSwapAbs MOD zs z1 z2 A' A)"
definition gSwapAllPresGWlsAll where
"gSwapAllPresGWlsAll MOD ≡ gSwapPresGWls MOD ∧ gSwapAbsPresGWlsAbs MOD"
lemmas gSwapAllPresGWlsAll_defs =
gSwapAllPresGWlsAll_def gSwapPresGWls_def gSwapAbsPresGWlsAbs_def
text‹``subst" preserves the domains:›
definition gSubstPresGWls where
"gSubstPresGWls MOD ≡ ∀ ys Y' Y y s X' X.
wls (asSort ys) Y' ∧ gWls MOD (asSort ys) Y ∧ wls s X' ∧ gWls MOD s X ⟶
gWls MOD s (gSubst MOD ys Y' Y y X' X)"
definition gSubstAbsPresGWlsAbs where
"gSubstAbsPresGWlsAbs MOD ≡ ∀ ys Y' Y y us s A' A.
isInBar (us,s) ∧
wls (asSort ys) Y' ∧ gWls MOD (asSort ys) Y ∧ wlsAbs (us,s) A' ∧ gWlsAbs MOD (us,s) A ⟶
gWlsAbs MOD (us,s) (gSubstAbs MOD ys Y' Y y A' A)"
definition gSubstAllPresGWlsAll where
"gSubstAllPresGWlsAll MOD ≡ gSubstPresGWls MOD ∧ gSubstAbsPresGWlsAbs MOD"
lemmas gSubstAllPresGWlsAll_defs =
gSubstAllPresGWlsAll_def gSubstPresGWls_def gSubstAbsPresGWlsAbs_def
text‹Clauses for fresh:›
definition gFreshGVar where
"gFreshGVar MOD ≡ ∀ ys y xs x.
(ys ≠ xs ∨ y ≠ x) ⟶
gFresh MOD ys y (Var xs x) (gVar MOD xs x)"
definition gFreshGAbs1 where
"gFreshGAbs1 MOD ≡ ∀ ys y s X' X.
isInBar (ys,s) ∧ wls s X' ∧ gWls MOD s X ⟶
gFreshAbs MOD ys y (Abs ys y X') (gAbs MOD ys y X' X)"
definition gFreshGAbs2 where
"gFreshGAbs2 MOD ≡ ∀ ys y xs x s X' X.
isInBar (xs,s) ∧ wls s X' ∧ gWls MOD s X ⟶
fresh ys y X' ∧ gFresh MOD ys y X' X ⟶
gFreshAbs MOD ys y (Abs xs x X') (gAbs MOD xs x X' X)"
definition gFreshGOp where
"gFreshGOp MOD ≡ ∀ ys y delta inp' inp binp' binp.
wlsInp delta inp' ∧ gWlsInp MOD delta inp ∧ wlsBinp delta binp' ∧ gWlsBinp MOD delta binp ⟶
freshInp ys y inp' ∧ gFreshInp MOD ys y inp' inp ∧
freshBinp ys y binp' ∧ gFreshBinp MOD ys y binp' binp ⟶
gFresh MOD ys y (Op delta inp' binp') (gOp MOD delta inp' inp binp' binp)"
definition gFreshCls where
"gFreshCls MOD ≡ gFreshGVar MOD ∧ gFreshGAbs1 MOD ∧ gFreshGAbs2 MOD ∧ gFreshGOp MOD"
lemmas gFreshCls_defs = gFreshCls_def
gFreshGVar_def gFreshGAbs1_def gFreshGAbs2_def gFreshGOp_def
definition gSwapGVar where
"gSwapGVar MOD ≡ ∀ zs z1 z2 xs x.
gSwap MOD zs z1 z2 (Var xs x) (gVar MOD xs x) =
gVar MOD xs (x @xs[z1 ∧ z2]_zs)"
definition gSwapGAbs where
"gSwapGAbs MOD ≡ ∀ zs z1 z2 xs x s X' X.
isInBar (xs,s) ∧ wls s X' ∧ gWls MOD s X ⟶
gSwapAbs MOD zs z1 z2 (Abs xs x X') (gAbs MOD xs x X' X) =
gAbs MOD xs (x @xs[z1 ∧ z2]_zs) (X' #[z1 ∧ z2]_zs) (gSwap MOD zs z1 z2 X' X)"
definition gSwapGOp where
"gSwapGOp MOD ≡ ∀ zs z1 z2 delta inp' inp binp' binp.
wlsInp delta inp' ∧ gWlsInp MOD delta inp ∧ wlsBinp delta binp' ∧ gWlsBinp MOD delta binp ⟶
gSwap MOD zs z1 z2 (Op delta inp' binp') (gOp MOD delta inp' inp binp' binp) =
gOp MOD delta
(inp' %[z1 ∧ z2]_zs) (gSwapInp MOD zs z1 z2 inp' inp)
(binp' %%[z1 ∧ z2]_zs) (gSwapBinp MOD zs z1 z2 binp' binp)"
definition gSwapCls where
"gSwapCls MOD ≡ gSwapGVar MOD ∧ gSwapGAbs MOD ∧ gSwapGOp MOD"
lemmas gSwapCls_defs = gSwapCls_def
gSwapGVar_def gSwapGAbs_def gSwapGOp_def
definition gSubstGVar1 where
"gSubstGVar1 MOD ≡ ∀ ys y Y' Y xs x.
wls (asSort ys) Y' ∧ gWls MOD (asSort ys) Y ⟶
(ys ≠ xs ∨ y ≠ x) ⟶
gSubst MOD ys Y' Y y (Var xs x) (gVar MOD xs x) =
gVar MOD xs x"
definition gSubstGVar2 where
"gSubstGVar2 MOD ≡ ∀ ys y Y' Y.
wls (asSort ys) Y' ∧ gWls MOD (asSort ys) Y ⟶
gSubst MOD ys Y' Y y (Var ys y) (gVar MOD ys y) = Y"
definition gSubstGAbs where
"gSubstGAbs MOD ≡ ∀ ys y Y' Y xs x s X' X.
isInBar (xs,s) ∧
wls (asSort ys) Y' ∧ gWls MOD (asSort ys) Y ∧
wls s X' ∧ gWls MOD s X ⟶
(xs ≠ ys ∨ x ≠ y) ∧ fresh xs x Y' ∧ gFresh MOD xs x Y' Y ⟶
gSubstAbs MOD ys Y' Y y (Abs xs x X') (gAbs MOD xs x X' X) =
gAbs MOD xs x (X' #[Y' / y]_ys) (gSubst MOD ys Y' Y y X' X)"
definition gSubstGOp where
"gSubstGOp MOD ≡ ∀ ys y Y' Y delta inp' inp binp' binp.
wls (asSort ys) Y' ∧ gWls MOD (asSort ys) Y ∧
wlsInp delta inp' ∧ gWlsInp MOD delta inp ∧
wlsBinp delta binp' ∧ gWlsBinp MOD delta binp ⟶
gSubst MOD ys Y' Y y (Op delta inp' binp') (gOp MOD delta inp' inp binp' binp) =
gOp MOD delta
(inp' %[Y' / y]_ys) (gSubstInp MOD ys Y' Y y inp' inp)
(binp' %%[Y' / y]_ys) (gSubstBinp MOD ys Y' Y y binp' binp)"
definition gSubstCls where
"gSubstCls MOD ≡ gSubstGVar1 MOD ∧ gSubstGVar2 MOD ∧ gSubstGAbs MOD ∧ gSubstGOp MOD"
lemmas gSubstCls_defs = gSubstCls_def
gSubstGVar1_def gSubstGVar2_def gSubstGAbs_def gSubstGOp_def
definition gAbsCongS where
"gAbsCongS MOD ≡ ∀ xs x x2 y s X' X X2' X2.
isInBar (xs,s) ∧
wls s X' ∧ gWls MOD s X ∧
wls s X2' ∧ gWls MOD s X2 ⟶
fresh xs y X' ∧ gFresh MOD xs y X' X ∧
fresh xs y X2' ∧ gFresh MOD xs y X2' X2 ∧
(X' #[y ∧ x]_xs) = (X2' #[y ∧ x2]_xs) ⟶
gSwap MOD xs y x X' X = gSwap MOD xs y x2 X2' X2 ⟶
gAbs MOD xs x X' X = gAbs MOD xs x2 X2' X2"
definition gAbsRen where
"gAbsRen MOD ≡ ∀ xs y x s X' X.
isInBar (xs,s) ∧ wls s X' ∧ gWls MOD s X ⟶
fresh xs y X' ∧ gFresh MOD xs y X' X ⟶
gAbs MOD xs y (X' #[y // x]_xs) (gSubst MOD xs (Var xs y) (gVar MOD xs y) x X' X) =
gAbs MOD xs x X' X"
text ‹Well-sorted fresh-swap models:›
definition wlsFSw where
"wlsFSw MOD ≡ gWlsAllDisj MOD ∧ gWlsAbsIsInBar MOD ∧
gConsPresGWls MOD ∧ gSwapAllPresGWlsAll MOD ∧
gFreshCls MOD ∧ gSwapCls MOD ∧ gAbsCongS MOD"
lemmas wlsFSw_defs1 = wlsFSw_def
gWlsAllDisj_def gWlsAbsIsInBar_def
gConsPresGWls_def gSwapAllPresGWlsAll_def
gFreshCls_def gSwapCls_def gAbsCongS_def
lemmas wlsFSw_defs = wlsFSw_def
gWlsAllDisj_defs gWlsAbsIsInBar_def
gConsPresGWls_defs gSwapAllPresGWlsAll_defs
gFreshCls_defs gSwapCls_defs gAbsCongS_def
text ‹Well-sorted fresh-subst models:›
definition wlsFSb where
"wlsFSb MOD ≡ gWlsAllDisj MOD ∧ gWlsAbsIsInBar MOD ∧
gConsPresGWls MOD ∧ gSubstAllPresGWlsAll MOD ∧
gFreshCls MOD ∧ gSubstCls MOD ∧ gAbsRen MOD"
lemmas wlsFSb_defs1 = wlsFSb_def
gWlsAllDisj_def gWlsAbsIsInBar_def
gConsPresGWls_def gSubstAllPresGWlsAll_def
gFreshCls_def gSubstCls_def gAbsRen_def
lemmas wlsFSb_defs = wlsFSb_def
gWlsAllDisj_defs gWlsAbsIsInBar_def
gConsPresGWls_defs gSubstAllPresGWlsAll_defs
gFreshCls_defs gSubstCls_defs gAbsRen_def
text ‹Well-sorted fresh-swap-subst-models›
definition wlsFSwSb where
"wlsFSwSb MOD ≡ wlsFSw MOD ∧ gSubstAllPresGWlsAll MOD ∧ gSubstCls MOD"
lemmas wlsFSwSb_defs1 = wlsFSwSb_def
wlsFSw_def gSubstAllPresGWlsAll_def gSubstCls_def
lemmas wlsFSwSb_defs = wlsFSwSb_def
wlsFSw_def gSubstAllPresGWlsAll_defs gSubstCls_defs
text ‹Well-sorted fresh-subst-swap-models›
definition wlsFSbSw where
"wlsFSbSw MOD ≡ wlsFSb MOD ∧ gSwapAllPresGWlsAll MOD ∧ gSwapCls MOD"
lemmas wlsFSbSw_defs1 = wlsFSbSw_def
wlsFSw_def gSwapAllPresGWlsAll_def gSwapCls_def
lemmas wlsFSbSw_defs = wlsFSbSw_def
wlsFSw_def gSwapAllPresGWlsAll_defs gSwapCls_defs
text‹Extension of domain preservation (by swap and subst) to inputs:›
text ‹First for free inputs:›
definition gSwapInpPresGWlsInp where
"gSwapInpPresGWlsInp MOD ≡ ∀ zs z1 z2 delta inp' inp.
wlsInp delta inp' ∧ gWlsInp MOD delta inp ⟶
gWlsInp MOD delta (gSwapInp MOD zs z1 z2 inp' inp)"
definition gSubstInpPresGWlsInp where
"gSubstInpPresGWlsInp MOD ≡ ∀ ys y Y' Y delta inp' inp.
wls (asSort ys) Y' ∧ gWls MOD (asSort ys) Y ∧
wlsInp delta inp' ∧ gWlsInp MOD delta inp ⟶
gWlsInp MOD delta (gSubstInp MOD ys Y' Y y inp' inp)"
lemma imp_gSwapInpPresGWlsInp:
"gSwapPresGWls MOD ⟹ gSwapInpPresGWlsInp MOD"
by (auto simp: lift2_def liftAll2_def sameDom_def wlsInp_iff gWlsInp_def
gSwapPresGWls_def gSwapInpPresGWlsInp_def gSwapInp_def
split: option.splits)
lemma imp_gSubstInpPresGWlsInp:
"gSubstPresGWls MOD ⟹ gSubstInpPresGWlsInp MOD"
by (auto simp: lift2_def liftAll2_def sameDom_def wlsInp_iff gWlsInp_def
gSubstPresGWls_def gSubstInpPresGWlsInp_def gSubstInp_def
split: option.splits)
text ‹Then for bound inputs:›
definition gSwapBinpPresGWlsBinp where
"gSwapBinpPresGWlsBinp MOD ≡ ∀ zs z1 z2 delta binp' binp.
wlsBinp delta binp' ∧ gWlsBinp MOD delta binp ⟶
gWlsBinp MOD delta (gSwapBinp MOD zs z1 z2 binp' binp)"
definition gSubstBinpPresGWlsBinp where
"gSubstBinpPresGWlsBinp MOD ≡ ∀ ys y Y' Y delta binp' binp.
wls (asSort ys) Y' ∧ gWls MOD (asSort ys) Y ∧
wlsBinp delta binp' ∧ gWlsBinp MOD delta binp ⟶
gWlsBinp MOD delta (gSubstBinp MOD ys Y' Y y binp' binp)"
lemma imp_gSwapBinpPresGWlsBinp:
"gSwapAbsPresGWlsAbs MOD ⟹ gSwapBinpPresGWlsBinp MOD"
by (auto simp: lift2_def liftAll2_def sameDom_def wlsBinp_iff gWlsBinp_def
gSwapAbsPresGWlsAbs_def gSwapBinpPresGWlsBinp_def gSwapBinp_def
split: option.splits)
lemma imp_gSubstBinpPresGWlsBinp:
"gSubstAbsPresGWlsAbs MOD ⟹ gSubstBinpPresGWlsBinp MOD"
by (auto simp: lift2_def liftAll2_def sameDom_def wlsBinp_iff gWlsBinp_def
gSubstAbsPresGWlsAbs_def gSubstBinpPresGWlsBinp_def gSubstBinp_def
split: option.splits)
subsection‹Model morphisms from the term model›
definition presWls where
"presWls h MOD ≡ ∀ s X. wls s X ⟶ gWls MOD s (h X)"
definition presWlsAbs where
"presWlsAbs hA MOD ≡ ∀ us s A. wlsAbs (us,s) A ⟶ gWlsAbs MOD (us,s) (hA A)"
definition presWlsAll where
"presWlsAll h hA MOD ≡ presWls h MOD ∧ presWlsAbs hA MOD"
lemmas presWlsAll_defs = presWlsAll_def presWls_def presWlsAbs_def
definition presVar where
"presVar h MOD ≡ ∀ xs x. h (Var xs x) = gVar MOD xs x"
definition presAbs where
"presAbs h hA MOD ≡ ∀ xs x s X.
isInBar (xs,s) ∧ wls s X ⟶
hA (Abs xs x X) = gAbs MOD xs x X (h X)"
definition presOp where
"presOp h hA MOD ≡ ∀ delta inp binp.
wlsInp delta inp ∧ wlsBinp delta binp ⟶
h (Op delta inp binp) =
gOp MOD delta inp (lift h inp) binp (lift hA binp)"
definition presCons where
"presCons h hA MOD ≡ presVar h MOD ∧ presAbs h hA MOD ∧ presOp h hA MOD"
lemmas presCons_defs = presCons_def
presVar_def presAbs_def presOp_def
definition presFresh where
"presFresh h MOD ≡ ∀ ys y s X.
wls s X ⟶
fresh ys y X ⟶ gFresh MOD ys y X (h X)"
definition presFreshAbs where
"presFreshAbs hA MOD ≡ ∀ ys y us s A.
wlsAbs (us,s) A ⟶
freshAbs ys y A ⟶ gFreshAbs MOD ys y A (hA A)"
definition presFreshAll where
"presFreshAll h hA MOD ≡ presFresh h MOD ∧ presFreshAbs hA MOD"
lemmas presFreshAll_defs = presFreshAll_def
presFresh_def presFreshAbs_def
definition presSwap where
"presSwap h MOD ≡ ∀ zs z1 z2 s X.
wls s X ⟶
h (X #[z1 ∧ z2]_zs) = gSwap MOD zs z1 z2 X (h X)"
definition presSwapAbs where
"presSwapAbs hA MOD ≡ ∀ zs z1 z2 us s A.
wlsAbs (us,s) A ⟶
hA (A $[z1 ∧ z2]_zs) = gSwapAbs MOD zs z1 z2 A (hA A)"
definition presSwapAll where
"presSwapAll h hA MOD ≡ presSwap h MOD ∧ presSwapAbs hA MOD"
lemmas presSwapAll_defs = presSwapAll_def
presSwap_def presSwapAbs_def
definition presSubst where
"presSubst h MOD ≡ ∀ ys Y y s X.
wls (asSort ys) Y ∧ wls s X ⟶
h (subst ys Y y X) = gSubst MOD ys Y (h Y) y X (h X)"
definition presSubstAbs where
"presSubstAbs h hA MOD ≡ ∀ ys Y y us s A.
wls (asSort ys) Y ∧ wlsAbs (us,s) A ⟶
hA (A $[Y / y]_ys) = gSubstAbs MOD ys Y (h Y) y A (hA A)"
definition presSubstAll where
"presSubstAll h hA MOD ≡ presSubst h MOD ∧ presSubstAbs h hA MOD"
lemmas presSubstAll_defs = presSubstAll_def
presSubst_def presSubstAbs_def
definition termFSwMorph where
"termFSwMorph h hA MOD ≡ presWlsAll h hA MOD ∧ presCons h hA MOD ∧
presFreshAll h hA MOD ∧ presSwapAll h hA MOD"
lemmas termFSwMorph_defs1 = termFSwMorph_def
presWlsAll_def presCons_def presFreshAll_def presSwapAll_def
lemmas termFSwMorph_defs = termFSwMorph_def
presWlsAll_defs presCons_defs presFreshAll_defs presSwapAll_defs
definition termFSbMorph where
"termFSbMorph h hA MOD ≡ presWlsAll h hA MOD ∧ presCons h hA MOD ∧
presFreshAll h hA MOD ∧ presSubstAll h hA MOD"
lemmas termFSbMorph_defs1 = termFSbMorph_def
presWlsAll_def presCons_def presFreshAll_def presSubstAll_def
lemmas termFSbMorph_defs = termFSbMorph_def
presWlsAll_defs presCons_defs presFreshAll_defs presSubstAll_defs
definition termFSwSbMorph where
"termFSwSbMorph h hA MOD ≡ termFSwMorph h hA MOD ∧ presSubstAll h hA MOD"
lemmas termFSwSbMorph_defs1 = termFSwSbMorph_def
termFSwMorph_def presSubstAll_def
lemmas termFSwSbMorph_defs = termFSwSbMorph_def
termFSwMorph_defs presSubstAll_defs
text‹Extension of domain preservation (by the morphisms) to inputs›
text‹. for free inputs:›
lemma presWls_wlsInp:
"wlsInp delta inp ⟹ presWls h MOD ⟹ gWlsInp MOD delta (lift h inp)"
by(auto simp: wlsInp_iff gWlsInp_def lift_def liftAll2_def sameDom_def
presWls_def split: option.splits)
text‹. for bound inputs:›
lemma presWls_wlsBinp:
"wlsBinp delta binp ⟹ presWlsAbs hA MOD ⟹ gWlsBinp MOD delta (lift hA binp)"
by(auto simp: wlsBinp_iff gWlsBinp_def lift_def liftAll2_def sameDom_def
presWlsAbs_def split: option.splits)
subsection ‹From models to iterative models›
text ‹The transition map:›
definition fromMOD ::
"('index,'bindex,'varSort,'sort,'opSym,'var,'gTerm,'gAbs) model
⇒
('index,'bindex,'varSort,'sort,'opSym,'var,
('index,'bindex,'varSort,'var,'opSym)term × 'gTerm,
('index,'bindex,'varSort,'var,'opSym)abs × 'gAbs) Iteration.model"
where
"fromMOD MOD ≡
⦇
igWls = λs X'X. wls s (fst X'X) ∧ gWls MOD s (snd X'X),
igWlsAbs = λus_s A'A. wlsAbs us_s (fst A'A) ∧ gWlsAbs MOD us_s (snd A'A),
igVar = λxs x. (Var xs x, gVar MOD xs x),
igAbs = λxs x X'X. (Abs xs x (fst X'X), gAbs MOD xs x (fst X'X) (snd X'X)),
igOp =
λdelta iinp biinp.
(Op delta (lift fst iinp) (lift fst biinp),
gOp MOD delta
(lift fst iinp) (lift snd iinp)
(lift fst biinp) (lift snd biinp)),
igFresh =
λys y X'X. fresh ys y (fst X'X) ∧ gFresh MOD ys y (fst X'X) (snd X'X),
igFreshAbs =
λys y A'A. freshAbs ys y (fst A'A) ∧ gFreshAbs MOD ys y (fst A'A) (snd A'A),
igSwap =
λzs z1 z2 X'X. ((fst X'X) #[z1 ∧ z2]_zs, gSwap MOD zs z1 z2 (fst X'X) (snd X'X)),
igSwapAbs =
λzs z1 z2 A'A. ((fst A'A) $[z1 ∧ z2]_zs, gSwapAbs MOD zs z1 z2 (fst A'A) (snd A'A)),
igSubst =
λys Y'Y y X'X.
((fst X'X) #[(fst Y'Y) / y]_ys,
gSubst MOD ys (fst Y'Y) (snd Y'Y) y (fst X'X) (snd X'X)),
igSubstAbs =
λys Y'Y y A'A.
((fst A'A) $[(fst Y'Y) / y]_ys,
gSubstAbs MOD ys (fst Y'Y) (snd Y'Y) y (fst A'A) (snd A'A))
⦈"
text‹Basic simplification rules:›
lemma fromMOD_basic_simps[simp]:
"igWls (fromMOD MOD) s X'X =
(wls s (fst X'X) ∧ gWls MOD s (snd X'X))"
"igWlsAbs (fromMOD MOD) us_s A'A =
(wlsAbs us_s (fst A'A) ∧ gWlsAbs MOD us_s (snd A'A))"
"igVar (fromMOD MOD) xs x = (Var xs x, gVar MOD xs x)"
"igAbs (fromMOD MOD) xs x X'X = (Abs xs x (fst X'X), gAbs MOD xs x (fst X'X) (snd X'X))"
"igOp (fromMOD MOD) delta iinp biinp =
(Op delta (lift fst iinp) (lift fst biinp),
gOp MOD delta
(lift fst iinp) (lift snd iinp)
(lift fst biinp) (lift snd biinp))"
"igFresh (fromMOD MOD) ys y X'X =
(fresh ys y (fst X'X) ∧ gFresh MOD ys y (fst X'X) (snd X'X))"
"igFreshAbs (fromMOD MOD) ys y A'A =
(freshAbs ys y (fst A'A) ∧ gFreshAbs MOD ys y (fst A'A) (snd A'A))"
"igSwap (fromMOD MOD) zs z1 z2 X'X =
((fst X'X) #[z1 ∧ z2]_zs, gSwap MOD zs z1 z2 (fst X'X) (snd X'X))"
"igSwapAbs (fromMOD MOD) zs z1 z2 A'A =
((fst A'A) $[z1 ∧ z2]_zs, gSwapAbs MOD zs z1 z2 (fst A'A) (snd A'A))"
"igSubst (fromMOD MOD) ys Y'Y y X'X =
((fst X'X) #[(fst Y'Y) / y]_ys,
gSubst MOD ys (fst Y'Y) (snd Y'Y) y (fst X'X) (snd X'X))"
"igSubstAbs (fromMOD MOD) ys Y'Y y A'A =
((fst A'A) $[(fst Y'Y) / y]_ys,
gSubstAbs MOD ys (fst Y'Y) (snd Y'Y) y (fst A'A) (snd A'A))"
unfolding fromMOD_def by auto
text‹Simps for inputs›
text‹. for free inputs:›
lemma igWlsInp_fromMOD[simp]:
"igWlsInp (fromMOD MOD) delta iinp ⟷
wlsInp delta (lift fst iinp) ∧ gWlsInp MOD delta (lift snd iinp)"
apply (intro iffI)
subgoal apply(simp add: liftAll2_def lift_def sameDom_def
igWlsInp_def wlsInp_iff gWlsInp_def split: option.splits) .
subgoal
unfolding liftAll2_def lift_def sameDom_def
igWlsInp_def wlsInp_iff gWlsInp_def
by simp (metis (no_types, lifting) eq_snd_iff fstI option.case_eq_if
option.distinct(1) option.simps(5)) .
lemma igFreshInp_fromMOD[simp]:
"igFreshInp (fromMOD MOD) ys y iinp ⟷
freshInp ys y (lift fst iinp) ∧ gFreshInp MOD ys y (lift fst iinp) (lift snd iinp)"
by (auto simp: igFreshInp_def gFreshInp_def freshInp_def
liftAll2_def liftAll_def lift_def split: option.splits)
lemma igSwapInp_fromMOD[simp]:
"igSwapInp (fromMOD MOD) zs z1 z2 iinp =
lift2 Pair
(swapInp zs z1 z2 (lift fst iinp))
(gSwapInp MOD zs z1 z2 (lift fst iinp) (lift snd iinp))"
by(auto simp: igSwapInp_def swapInp_def gSwapInp_def lift_def lift2_def
split: option.splits)
lemma igSubstInp_fromMOD[simp]:
"igSubstInp (fromMOD MOD) ys Y'Y y iinp =
lift2 Pair
(substInp ys (fst Y'Y) y (lift fst iinp))
(gSubstInp MOD ys (fst Y'Y) (snd Y'Y) y (lift fst iinp) (lift snd iinp))"
by(auto simp: igSubstInp_def substInp_def2 gSubstInp_def lift_def lift2_def
split: option.splits)
lemmas input_fromMOD_simps =
igWlsInp_fromMOD igFreshInp_fromMOD igSwapInp_fromMOD igSubstInp_fromMOD
text‹. for bound inputs:›
lemma igWlsBinp_fromMOD[simp]:
"igWlsBinp (fromMOD MOD) delta biinp ⟷
(wlsBinp delta (lift fst biinp) ∧ gWlsBinp MOD delta (lift snd biinp))"
apply (intro iffI)
subgoal apply(simp add: liftAll2_def lift_def sameDom_def
igWlsBinp_def wlsBinp_iff gWlsBinp_def split: option.splits) .
subgoal
unfolding liftAll2_def lift_def sameDom_def
igWlsBinp_def wlsBinp_iff gWlsBinp_def
by simp (metis (no_types, lifting) eq_snd_iff fstI option.case_eq_if
option.distinct(1) option.simps(5)) .
lemma igFreshBinp_fromMOD[simp]:
"igFreshBinp (fromMOD MOD) ys y biinp ⟷
(freshBinp ys y (lift fst biinp) ∧
gFreshBinp MOD ys y (lift fst biinp) (lift snd biinp))"
by (auto simp: igFreshBinp_def gFreshBinp_def freshBinp_def
liftAll2_def liftAll_def lift_def split: option.splits)
lemma igSwapBinp_fromMOD[simp]:
"igSwapBinp (fromMOD MOD) zs z1 z2 biinp =
lift2 Pair
(swapBinp zs z1 z2 (lift fst biinp))
(gSwapBinp MOD zs z1 z2 (lift fst biinp) (lift snd biinp))"
by(auto simp: igSwapBinp_def swapBinp_def gSwapBinp_def lift_def lift2_def
split: option.splits)
lemma igSubstBinp_fromMOD[simp]:
"igSubstBinp (fromMOD MOD) ys Y'Y y biinp =
lift2 Pair
(substBinp ys (fst Y'Y) y (lift fst biinp))
(gSubstBinp MOD ys (fst Y'Y) (snd Y'Y) y (lift fst biinp) (lift snd biinp))"
by(auto simp: igSubstBinp_def substBinp_def2 gSubstBinp_def lift_def lift2_def
split: option.splits)
lemmas binput_fromMOD_simps =
igWlsBinp_fromMOD igFreshBinp_fromMOD igSwapBinp_fromMOD igSubstBinp_fromMOD
text‹Domain disjointness:›
lemma igWlsDisj_fromMOD[simp]:
"gWlsDisj MOD ⟹ igWlsDisj (fromMOD MOD)"
unfolding igWlsDisj_def gWlsDisj_def by auto
lemma igWlsAbsDisj_fromMOD[simp]:
"gWlsAbsDisj MOD ⟹ igWlsAbsDisj (fromMOD MOD)"
unfolding igWlsAbsDisj_def gWlsAbsDisj_def by fastforce
lemma igWlsAllDisj_fromMOD[simp]:
"gWlsAllDisj MOD ⟹ igWlsAllDisj (fromMOD MOD)"
unfolding igWlsAllDisj_def gWlsAllDisj_def by fastforce
lemmas igWlsAllDisj_fromMOD_simps =
igWlsDisj_fromMOD igWlsAbsDisj_fromMOD igWlsAllDisj_fromMOD
text‹Abstractions only within IsInBar:›
lemma igWlsAbsIsInBar_fromMOD[simp]:
"gWlsAbsIsInBar MOD ⟹ igWlsAbsIsInBar (fromMOD MOD)"
unfolding gWlsAbsIsInBar_def igWlsAbsIsInBar_def by simp
text‹The constructs preserve the domains:›
lemma igVarIPresIGWls_fromMOD[simp]:
"gVarPresGWls MOD ⟹ igVarIPresIGWls (fromMOD MOD)"
unfolding igVarIPresIGWls_def gVarPresGWls_def by simp
lemma igAbsIPresIGWls_fromMOD[simp]:
"gAbsPresGWls MOD ⟹ igAbsIPresIGWls (fromMOD MOD)"
unfolding igAbsIPresIGWls_def gAbsPresGWls_def by simp
lemma igOpIPresIGWls_fromMOD[simp]:
"gOpPresGWls MOD ⟹ igOpIPresIGWls (fromMOD MOD)"
unfolding igOpIPresIGWls_def gOpPresGWls_def by simp
lemma igConsIPresIGWls_fromMOD[simp]:
"gConsPresGWls MOD ⟹ igConsIPresIGWls (fromMOD MOD)"
unfolding igConsIPresIGWls_def gConsPresGWls_def by simp
lemmas igConsIPresIGWls_fromMOD_simps =
igVarIPresIGWls_fromMOD igAbsIPresIGWls_fromMOD
igOpIPresIGWls_fromMOD igConsIPresIGWls_fromMOD
text‹Swap preserves the domains:›
lemma igSwapIPresIGWls_fromMOD[simp]:
"gSwapPresGWls MOD ⟹ igSwapIPresIGWls (fromMOD MOD)"
unfolding igSwapIPresIGWls_def gSwapPresGWls_def by simp
lemma igSwapAbsIPresIGWlsAbs_fromMOD[simp]:
"gSwapAbsPresGWlsAbs MOD ⟹ igSwapAbsIPresIGWlsAbs (fromMOD MOD)"
unfolding igSwapAbsIPresIGWlsAbs_def gSwapAbsPresGWlsAbs_def by simp
lemma igSwapAllIPresIGWlsAll_fromMOD[simp]:
"gSwapAllPresGWlsAll MOD ⟹ igSwapAllIPresIGWlsAll (fromMOD MOD)"
unfolding igSwapAllIPresIGWlsAll_def gSwapAllPresGWlsAll_def by simp
lemmas igSwapAllIPresIGWlsAll_fromMOD_simps =
igSwapIPresIGWls_fromMOD igSwapAbsIPresIGWlsAbs_fromMOD igSwapAllIPresIGWlsAll_fromMOD
text‹Subst preserves the domains:›
lemma igSubstIPresIGWls_fromMOD[simp]:
"gSubstPresGWls MOD ⟹ igSubstIPresIGWls (fromMOD MOD)"
unfolding igSubstIPresIGWls_def gSubstPresGWls_def by simp
lemma igSubstAbsIPresIGWlsAbs_fromMOD[simp]:
"gSubstAbsPresGWlsAbs MOD ⟹ igSubstAbsIPresIGWlsAbs (fromMOD MOD)"
unfolding igSubstAbsIPresIGWlsAbs_def gSubstAbsPresGWlsAbs_def by simp
lemma igSubstAllIPresIGWlsAll_fromMOD[simp]:
"gSubstAllPresGWlsAll MOD ⟹ igSubstAllIPresIGWlsAll (fromMOD MOD)"
unfolding igSubstAllIPresIGWlsAll_def gSubstAllPresGWlsAll_def by simp
lemmas igSubstAllIPresIGWlsAll_fromMOD_simps =
igSubstIPresIGWls_fromMOD igSubstAbsIPresIGWlsAbs_fromMOD igSubstAllIPresIGWlsAll_fromMOD
text‹The fresh clauses:›
lemma igFreshIGVar_fromMOD[simp]:
"gFreshGVar MOD ⟹ igFreshIGVar (fromMOD MOD)"
unfolding igFreshIGVar_def gFreshGVar_def by simp
lemma igFreshIGAbs1_fromMOD[simp]:
"gFreshGAbs1 MOD ⟹ igFreshIGAbs1 (fromMOD MOD)"
unfolding igFreshIGAbs1_def gFreshGAbs1_def by auto
lemma igFreshIGAbs2_fromMOD[simp]:
"gFreshGAbs2 MOD ⟹ igFreshIGAbs2 (fromMOD MOD)"
unfolding igFreshIGAbs2_def gFreshGAbs2_def by auto
lemma igFreshIGOp_fromMOD[simp]:
"gFreshGOp MOD ⟹ igFreshIGOp (fromMOD MOD)"
unfolding igFreshIGOp_def gFreshGOp_def by simp
lemma igFreshCls_fromMOD[simp]:
"gFreshCls MOD ⟹ igFreshCls (fromMOD MOD)"
unfolding igFreshCls_def gFreshCls_def by simp
lemmas igFreshCls_fromMOD_simps =
igFreshIGVar_fromMOD igFreshIGAbs1_fromMOD igFreshIGAbs2_fromMOD
igFreshIGOp_fromMOD igFreshCls_fromMOD
text‹The swap clauses›
lemma igSwapIGVar_fromMOD[simp]:
"gSwapGVar MOD ⟹ igSwapIGVar (fromMOD MOD)"
unfolding igSwapIGVar_def gSwapGVar_def by simp
lemma igSwapIGAbs_fromMOD[simp]:
"gSwapGAbs MOD ⟹ igSwapIGAbs (fromMOD MOD)"
unfolding igSwapIGAbs_def gSwapGAbs_def by auto
lemma igSwapIGOp_fromMOD[simp]:
"gSwapGOp MOD ⟹ igSwapIGOp (fromMOD MOD)"
by (auto simp: igSwapIGOp_def gSwapGOp_def lift_lift2)
lemma igSwapCls_fromMOD[simp]:
"gSwapCls MOD ⟹ igSwapCls (fromMOD MOD)"
unfolding igSwapCls_def gSwapCls_def by simp
lemmas igSwapCls_fromMOD_simps =
igSwapIGVar_fromMOD igSwapIGAbs_fromMOD
igSwapIGOp_fromMOD igSwapCls_fromMOD
text‹The subst clauses›
lemma igSubstIGVar1_fromMOD[simp]:
"gSubstGVar1 MOD ⟹ igSubstIGVar1 (fromMOD MOD)"
unfolding igSubstIGVar1_def gSubstGVar1_def by simp
lemma igSubstIGVar2_fromMOD[simp]:
"gSubstGVar2 MOD ⟹ igSubstIGVar2 (fromMOD MOD)"
unfolding igSubstIGVar2_def gSubstGVar2_def by simp
lemma igSubstIGAbs_fromMOD[simp]:
"gSubstGAbs MOD ⟹ igSubstIGAbs (fromMOD MOD)"
unfolding igSubstIGAbs_def gSubstGAbs_def by fastforce+
lemma igSubstIGOp_fromMOD[simp]:
"gSubstGOp MOD ⟹ igSubstIGOp (fromMOD MOD)"
by(auto simp: igSubstIGOp_def gSubstGOp_def lift_lift2)
lemma igSubstCls_fromMOD[simp]:
"gSubstCls MOD ⟹ igSubstCls (fromMOD MOD)"
unfolding igSubstCls_def gSubstCls_def by simp
lemmas igSubstCls_fromMOD_simps =
igSubstIGVar1_fromMOD igSubstIGVar2_fromMOD igSubstIGAbs_fromMOD
igSubstIGOp_fromMOD igSubstCls_fromMOD
text‹Abstraction swapping congruence:›
lemma igAbsCongS_fromMOD[simp]:
assumes "gAbsCongS MOD"
shows "igAbsCongS (fromMOD MOD)"
using assms
unfolding igAbsCongS_def gAbsCongS_def
apply simp
apply clarify
by (intro conjI, erule wls_Abs_swap_cong) blast+
text‹Abstraction renaming:›
lemma igAbsRen_fromMOD[simp]:
"gAbsRen MOD ⟹ igAbsRen (fromMOD MOD)"
unfolding igAbsRen_def gAbsRen_def vsubst_def by auto
text‹Models:›
lemma iwlsFSw_fromMOD[simp]:
"wlsFSw MOD ⟹ iwlsFSw (fromMOD MOD)"
unfolding iwlsFSw_def wlsFSw_def by simp
lemma iwlsFSb_fromMOD[simp]:
"wlsFSb MOD ⟹ iwlsFSb (fromMOD MOD)"
unfolding iwlsFSb_def wlsFSb_def by simp
lemma iwlsFSwSb_fromMOD[simp]:
"wlsFSwSb MOD ⟹ iwlsFSwSb (fromMOD MOD)"
unfolding iwlsFSwSb_def wlsFSwSb_def by simp
lemma iwlsFSbSw_fromMOD[simp]:
"wlsFSbSw MOD ⟹ iwlsFSbSw (fromMOD MOD)"
unfolding iwlsFSbSw_def wlsFSbSw_def by simp
lemmas iwlsModel_fromMOD_simps =
iwlsFSw_fromMOD iwlsFSb_fromMOD
iwlsFSwSb_fromMOD iwlsFSbSw_fromMOD
lemmas fromMOD_predicate_simps =
igWlsAllDisj_fromMOD_simps
igConsIPresIGWls_fromMOD_simps
igSwapAllIPresIGWlsAll_fromMOD_simps
igSubstAllIPresIGWlsAll_fromMOD_simps
igFreshCls_fromMOD_simps
igSwapCls_fromMOD_simps
igSubstCls_fromMOD_simps
igAbsCongS_fromMOD
igAbsRen_fromMOD
iwlsModel_fromMOD_simps
lemmas fromMOD_simps =
fromMOD_basic_simps
input_fromMOD_simps
binput_fromMOD_simps
fromMOD_predicate_simps
subsection ‹The recursion-iteration ``identity trick"›
text ‹Here we show that any construct-preserving map from terms to ``fromMOD MOD"
is the identity on its first projection -- this is the main trick when
reducing recursion to iteration.›
lemma ipresCons_fromMOD_fst:
assumes "ipresCons h hA (fromMOD MOD)"
shows "(wls s X ⟶ fst (h X) = X) ∧ (wlsAbs (us,s') A ⟶ fst (hA A) = A)"
proof(induction rule: wls_rawInduct)
next
case (Op delta inp binp)
hence "lift (fst ∘ h) inp = inp ∧ lift (fst ∘ hA) binp = binp"
by (simp add: lift_def fun_eq_iff liftAll2_def
wlsInp_iff wlsBinp_iff sameDom_def split: option.splits)
(metis not_Some_eq old.prod.exhaust)
then show ?case
using assms Op by (auto simp: ipresCons_def ipresOp_def lift_comp)
qed(insert assms, auto simp: ipresVar_def ipresCons_def ipresAbs_def)
lemma ipresCons_fromMOD_fst_simps[simp]:
"⟦ipresCons h hA (fromMOD MOD); wls s X⟧
⟹ fst (h X) = X"
"⟦ipresCons h hA (fromMOD MOD); wlsAbs (us,s') A⟧
⟹ fst (hA A) = A"
using ipresCons_fromMOD_fst by blast+
lemma ipresCons_fromMOD_fst_inp[simp]:
"ipresCons h hA (fromMOD MOD) ⟹ wlsInp delta inp ⟹ lift (fst o h) inp = inp"
by (force simp add: lift_def fun_eq_iff liftAll2_def
wlsInp_iff sameDom_def split: option.splits)
lemma ipresCons_fromMOD_fst_binp[simp]:
"ipresCons h hA (fromMOD MOD) ⟹ wlsBinp delta binp ⟹ lift (fst o hA) binp = binp"
by (force simp add: lift_def fun_eq_iff liftAll2_def
wlsBinp_iff sameDom_def split: option.splits)
lemmas ipresCons_fromMOD_fst_all_simps =
ipresCons_fromMOD_fst_simps ipresCons_fromMOD_fst_inp ipresCons_fromMOD_fst_binp
subsection ‹From iteration morphisms to morphisms›
text‹The transition map:›
definition fromIMor ::
"(('index,'bindex,'varSort,'var,'opSym)term ⇒
('index,'bindex,'varSort,'var,'opSym)term × 'gTerm)
⇒
(('index,'bindex,'varSort,'var,'opSym)term ⇒ 'gTerm)"
where "fromIMor h ≡ snd o h"
definition fromIMorAbs ::
"(('index,'bindex,'varSort,'var,'opSym)abs ⇒
('index,'bindex,'varSort,'var,'opSym)abs × 'gAbs)
⇒
(('index,'bindex,'varSort,'var,'opSym)abs ⇒ 'gAbs)"
where "fromIMorAbs hA ≡ snd o hA"
text‹Basic simplification rules:›
lemma fromIMor[simp]: "fromIMor h X' = snd (h X')"
unfolding fromIMor_def by simp
lemma fromIMorAbs[simp]: "fromIMorAbs hA A' = snd (hA A')"
unfolding fromIMorAbs_def by simp
lemma fromIMor_snd_inp[simp]:
"wlsInp delta inp ⟹ lift (fromIMor h) inp = lift (snd o h) inp"
by (auto simp: lift_def split: option.splits)
lemma fromIMorAbs_snd_binp[simp]:
"wlsBinp delta binp ⟹ lift (fromIMorAbs hA) binp = lift (snd o hA) binp"
by (auto simp: lift_def split: option.splits)
lemmas fromIMor_basic_simps =
fromIMor fromIMorAbs fromIMor_snd_inp fromIMorAbs_snd_binp
text‹Predicate simplification rules›
text‹Domain preservation›
lemma presWls_fromIMor[simp]:
"ipresWls h (fromMOD MOD) ⟹ presWls (fromIMor h) MOD"
unfolding ipresWls_def presWls_def by simp
lemma presWlsAbs_fromIMorAbs[simp]:
"ipresWlsAbs hA (fromMOD MOD) ⟹ presWlsAbs (fromIMorAbs hA) MOD"
unfolding ipresWlsAbs_def presWlsAbs_def by simp
lemma presWlsAll_fromIMorAll[simp]:
"ipresWlsAll h hA (fromMOD MOD) ⟹ presWlsAll (fromIMor h) (fromIMorAbs hA) MOD"
unfolding ipresWlsAll_def presWlsAll_def by simp
lemmas presWlsAll_fromIMorAll_simps =
presWls_fromIMor presWlsAbs_fromIMorAbs presWlsAll_fromIMorAll
text‹Preservation of the constructs›
lemma presVar_fromIMor[simp]:
"ipresCons h hA (fromMOD MOD) ⟹ presVar (fromIMor h) MOD"
unfolding ipresCons_def ipresVar_def presVar_def by simp
lemma presAbs_fromIMor[simp]:
assumes "ipresCons h hA (fromMOD MOD)"
shows "presAbs (fromIMor h) (fromIMorAbs hA) MOD"
using assms unfolding ipresCons_def ipresAbs_def presAbs_def
using assms by fastforce
lemma presOp_fromIMor[simp]:
assumes "ipresCons h hA (fromMOD MOD)"
shows "presOp (fromIMor h) (fromIMorAbs hA) MOD"
using assms unfolding ipresCons_def ipresOp_def presOp_def
using assms by (auto simp: lift_comp)
lemma presCons_fromIMor[simp]:
assumes "ipresCons h hA (fromMOD MOD)"
shows "presCons (fromIMor h) (fromIMorAbs hA) MOD"
unfolding ipresCons_def presCons_def using assms by simp
lemmas presCons_fromIMor_simps =
presVar_fromIMor presAbs_fromIMor presOp_fromIMor presCons_fromIMor
text‹Preservation of freshness›
lemma presFresh_fromIMor[simp]:
"ipresCons h hA (fromMOD MOD) ⟹ ipresFresh h (fromMOD MOD)
⟹ presFresh (fromIMor h) MOD"
unfolding ipresFresh_def presFresh_def by simp
lemma presFreshAbs_fromIMor[simp]:
"ipresCons h hA (fromMOD MOD) ⟹ ipresFreshAbs hA (fromMOD MOD)
⟹ presFreshAbs (fromIMorAbs hA) MOD"
unfolding ipresFreshAbs_def presFreshAbs_def by simp
lemma presFreshAll_fromIMor[simp]:
"ipresCons h hA (fromMOD MOD) ⟹ ipresFreshAll h hA (fromMOD MOD)
⟹ presFreshAll (fromIMor h) (fromIMorAbs hA) MOD"
unfolding ipresFreshAll_def presFreshAll_def by simp
lemmas presFreshAll_fromIMor_simps =
presFresh_fromIMor presFreshAbs_fromIMor presFreshAll_fromIMor
text‹Preservation of swap›
lemma presSwap_fromIMor[simp]:
"ipresCons h hA (fromMOD MOD) ⟹ ipresSwap h (fromMOD MOD)
⟹ presSwap (fromIMor h) MOD"
unfolding ipresSwap_def presSwap_def by simp
lemma presSwapAbs_fromIMor[simp]:
"ipresCons h hA (fromMOD MOD) ⟹ ipresSwapAbs hA (fromMOD MOD)
⟹ presSwapAbs (fromIMorAbs hA) MOD"
unfolding ipresSwapAbs_def presSwapAbs_def by simp
lemma presSwapAll_fromIMor[simp]:
"ipresCons h hA (fromMOD MOD) ⟹ ipresSwapAll h hA (fromMOD MOD)
⟹ presSwapAll (fromIMor h) (fromIMorAbs hA) MOD"
unfolding ipresSwapAll_def presSwapAll_def by simp
lemmas presSwapAll_fromIMor_simps =
presSwap_fromIMor presSwapAbs_fromIMor presSwapAll_fromIMor
text‹Preservation of subst›
lemma presSubst_fromIMor[simp]:
"ipresCons h hA (fromMOD MOD) ⟹ ipresSubst h (fromMOD MOD)
⟹ presSubst (fromIMor h) MOD"
unfolding ipresSubst_def presSubst_def by auto
lemma presSubstAbs_fromIMor[simp]:
"ipresCons h hA (fromMOD MOD) ⟹ ipresSubstAbs h hA (fromMOD MOD)
⟹ presSubstAbs (fromIMor h) (fromIMorAbs hA) MOD"
unfolding ipresSubstAbs_def presSubstAbs_def by auto
lemma presSubstAll_fromIMor[simp]:
"ipresCons h hA (fromMOD MOD) ⟹ ipresSubstAll h hA (fromMOD MOD)
⟹ presSubstAll (fromIMor h) (fromIMorAbs hA) MOD"
unfolding ipresSubstAll_def presSubstAll_def by simp
lemmas presSubstAll_fromIMor_simps =
presSubst_fromIMor presSubstAbs_fromIMor presSubstAll_fromIMor
text‹Morphisms›
lemma fromIMor_termFSwMorph[simp]:
"termFSwImorph h hA (fromMOD MOD) ⟹ termFSwMorph (fromIMor h) (fromIMorAbs hA) MOD"
unfolding termFSwImorph_def termFSwMorph_def by simp
lemma fromIMor_termFSbMorph[simp]:
"termFSbImorph h hA (fromMOD MOD) ⟹ termFSbMorph (fromIMor h) (fromIMorAbs hA) MOD"
unfolding termFSbImorph_def termFSbMorph_def by simp
lemma fromIMor_termFSwSbMorph[simp]:
assumes "termFSwSbImorph h hA (fromMOD MOD)"
shows "termFSwSbMorph (fromIMor h) (fromIMorAbs hA) MOD"
using assms unfolding termFSwSbImorph_defs1
using assms unfolding termFSwSbImorph_def termFSwSbMorph_def by simp
lemmas mor_fromIMor_simps =
fromIMor_termFSwMorph fromIMor_termFSbMorph fromIMor_termFSwSbMorph
lemmas fromIMor_predicate_simps =
presCons_fromIMor_simps
presFreshAll_fromIMor_simps
presSwapAll_fromIMor_simps
presSubstAll_fromIMor_simps
mor_fromIMor_simps
lemmas fromIMor_simps =
fromIMor_basic_simps fromIMor_predicate_simps
subsection ‹The recursion theorem›
text‹The recursion maps:›
definition rec where "rec MOD ≡ fromIMor (iter (fromMOD MOD))"
definition recAbs where "recAbs MOD ≡ fromIMorAbs (iterAbs (fromMOD MOD))"
text‹Existence:›
theorem wlsFSw_recAll_termFSwMorph:
"wlsFSw MOD ⟹ termFSwMorph (rec MOD) (recAbs MOD) MOD"
by (simp add: rec_def recAbs_def iwlsFSw_iterAll_termFSwImorph)
theorem wlsFSb_recAll_termFSbMorph:
"wlsFSb MOD ⟹ termFSbMorph (rec MOD) (recAbs MOD) MOD"
by (simp add: rec_def recAbs_def iwlsFSb_iterAll_termFSbImorph)
theorem wlsFSwSb_recAll_termFSwSbMorph:
"wlsFSwSb MOD ⟹ termFSwSbMorph (rec MOD) (recAbs MOD) MOD"
by (simp add: rec_def recAbs_def iwlsFSwSb_iterAll_termFSwSbImorph)
theorem wlsFSbSw_recAll_termFSwSbMorph:
"wlsFSbSw MOD ⟹ termFSwSbMorph (rec MOD) (recAbs MOD) MOD"
by (simp add: rec_def recAbs_def iwlsFSbSw_iterAll_termFSwSbImorph)
text‹Uniqueness:›
lemma presCons_unique:
assumes "presCons f fA MOD" and "presCons g gA MOD"
shows "(wls s X ⟶ f X = g X) ∧ (wlsAbs (us,s') A ⟶ fA A = gA A)"
proof(induction rule: wls_rawInduct)
case (Op delta inp binp)
hence "lift f inp = lift g inp ∧ lift fA binp = lift gA binp"
apply(simp add: lift_def wlsInp_iff wlsBinp_iff sameDom_def liftAll2_def fun_eq_iff split: option.splits)
by (metis not_Some_eq old.prod.exhaust)
then show ?case using assms Op unfolding presCons_def presOp_def by simp
qed(insert assms, auto simp: presVar_def presCons_def presAbs_def )
theorem wlsFSw_recAll_unique_presCons:
assumes "wlsFSw MOD" and "presCons h hA MOD"
shows "(wls s X ⟶ h X = rec MOD X) ∧
(wlsAbs (us,s') A ⟶ hA A = recAbs MOD A)"
using assms wlsFSw_recAll_termFSwMorph
by (intro presCons_unique) (auto simp: termFSwMorph_def)
theorem wlsFSb_recAll_unique_presCons:
assumes "wlsFSb MOD" and "presCons h hA MOD"
shows "(wls s X ⟶ h X = rec MOD X) ∧
(wlsAbs (us,s') A ⟶ hA A = recAbs MOD A)"
using assms wlsFSb_recAll_termFSbMorph
by (intro presCons_unique) (auto simp: termFSbMorph_def)
theorem wlsFSwSb_recAll_unique_presCons:
assumes "wlsFSwSb MOD" and "presCons h hA MOD"
shows "(wls s X ⟶ h X = rec MOD X) ∧
(wlsAbs (us,s') A ⟶ hA A = recAbs MOD A)"
using assms wlsFSw_recAll_unique_presCons unfolding wlsFSwSb_def by blast
theorem wlsFSbSw_recAll_unique_presCons:
assumes "wlsFSbSw MOD" and "presCons h hA MOD"
shows "(wls s X ⟶ h X = rec MOD X) ∧
(wlsAbs (us,s') A ⟶ hA A = recAbs MOD A)"
using assms wlsFSb_recAll_unique_presCons unfolding wlsFSbSw_def by blast
subsection‹Models that are even ``closer" to the term model›
text‹We describe various conditions (later referred to as ``extra clauses"
or ``extra conditions")
that, when satisfied by models,
yield the recursive maps
(1) freshness-preserving and/or (2) injective and/or (3) surjective, thus bringing the
considered models ``closer" to (being isomorphic to) the term model.
The extreme case, when all of (1)-(3) above are ensured, means indeed isomorphism to
the term model -- this is in fact an abstract characterization of the term model.›
subsubsection ‹Relevant predicates on models›
text‹The fresh clauses reversed›
definition gFreshGVarRev where
"gFreshGVarRev MOD ≡ ∀ xs y x.
gFresh MOD xs y (Var xs x) (gVar MOD xs x) ⟶ y ≠ x"
definition gFreshGAbsRev where
"gFreshGAbsRev MOD ≡ ∀ ys y xs x s X' X.
isInBar (xs,s) ∧ wls s X' ∧ gWls MOD s X ⟶
gFreshAbs MOD ys y (Abs xs x X') (gAbs MOD xs x X' X) ⟶
(ys = xs ∧ y = x) ∨ gFresh MOD ys y X' X"
definition gFreshGOpRev where
"gFreshGOpRev MOD ≡ ∀ ys y delta inp' inp binp' binp.
wlsInp delta inp' ∧ gWlsInp MOD delta inp ∧ wlsBinp delta binp' ∧ gWlsBinp MOD delta binp ⟶
gFresh MOD ys y (Op delta inp' binp') (gOp MOD delta inp' inp binp' binp) ⟶
gFreshInp MOD ys y inp' inp ∧ gFreshBinp MOD ys y binp' binp"
definition gFreshClsRev where
"gFreshClsRev MOD ≡ gFreshGVarRev MOD ∧ gFreshGAbsRev MOD ∧ gFreshGOpRev MOD"
lemmas gFreshClsRev_defs = gFreshClsRev_def
gFreshGVarRev_def gFreshGAbsRev_def gFreshGOpRev_def
text‹Injectiveness of the construct operators›
definition gVarInj where
"gVarInj MOD ≡ ∀ xs x y. gVar MOD xs x = gVar MOD xs y ⟶ x = y"
definition gAbsInj where
"gAbsInj MOD ≡ ∀ xs s x X' X X1' X1.
isInBar (xs,s) ∧ wls s X' ∧ gWls MOD s X ∧ wls s X1' ∧ gWls MOD s X1 ∧
gAbs MOD xs x X' X = gAbs MOD xs x X1' X1
⟶
X = X1"
definition gOpInj where
"gOpInj MOD ≡ ∀ delta delta1 inp' binp' inp binp inp1' binp1' inp1 binp1.
wlsInp delta inp' ∧ wlsBinp delta binp' ∧ gWlsInp MOD delta inp ∧ gWlsBinp MOD delta binp ∧
wlsInp delta1 inp1' ∧ wlsBinp delta1 binp1' ∧ gWlsInp MOD delta1 inp1 ∧ gWlsBinp MOD delta1 binp1 ∧
stOf delta = stOf delta1 ∧
gOp MOD delta inp' inp binp' binp = gOp MOD delta1 inp1' inp1 binp1' binp1
⟶
delta = delta1 ∧ inp = inp1 ∧ binp = binp1"
definition gVarGOpInj where
"gVarGOpInj MOD ≡ ∀ xs x delta inp' binp' inp binp.
wlsInp delta inp' ∧ wlsBinp delta binp' ∧ gWlsInp MOD delta inp ∧ gWlsBinp MOD delta binp ∧
asSort xs = stOf delta
⟶
gVar MOD xs x ≠ gOp MOD delta inp' inp binp' binp"
definition gConsInj where
"gConsInj MOD ≡ gVarInj MOD ∧ gAbsInj MOD ∧ gOpInj MOD ∧ gVarGOpInj MOD"
lemmas gConsInj_defs = gConsInj_def
gVarInj_def gAbsInj_def gOpInj_def gVarGOpInj_def
text‹Abstraction renaming for swapping›
definition gAbsRenS where
"gAbsRenS MOD ≡ ∀ xs y x s X' X.
isInBar (xs,s) ∧ wls s X' ∧ gWls MOD s X ⟶
fresh xs y X' ∧ gFresh MOD xs y X' X ⟶
gAbs MOD xs y (X' #[y ∧ x]_xs) (gSwap MOD xs y x X' X) =
gAbs MOD xs x X' X"
text‹Indifference to the general-recursive argument›
text‹. This ``indifference" property says that the construct operators
from the model only depend on
the generalized item (i.e., generalized term or abstraction) argument,
and {\em not} on the ``item" (i.e., concrete term or abstraction) argument.
In other words, the model constructs correspond to {\em iterative clauses},
and not to the more general notion of ``general-recursive" clause.›
definition gAbsIndif where
"gAbsIndif MOD ≡ ∀ xs s x X1' X2' X.
isInBar (xs,s) ∧ wls s X1' ∧ wls s X2' ∧ gWls MOD s X ⟶
gAbs MOD xs x X1' X = gAbs MOD xs x X2' X"
definition gOpIndif where
"gOpIndif MOD ≡ ∀ delta inp1' inp2' inp binp1' binp2' binp.
wlsInp delta inp1' ∧ wlsBinp delta binp1' ∧ wlsInp delta inp2' ∧ wlsBinp delta binp2' ∧
gWlsInp MOD delta inp ∧ gWlsBinp MOD delta binp
⟶
gOp MOD delta inp1' inp binp1' binp = gOp MOD delta inp2' inp binp2' binp"
definition gConsIndif where
"gConsIndif MOD ≡ gOpIndif MOD ∧ gAbsIndif MOD"
lemmas gConsIndif_defs = gConsIndif_def gAbsIndif_def gOpIndif_def
text‹Inductiveness›
text‹. Inductiveness of a model means the satisfaction of a minimal inductive
principle (``minimal" in the sense that no fancy swapping or freshness
induction-friendly conditions are involved).›
definition gInduct where
"gInduct MOD ≡ ∀ phi phiAbs s X us s' A.
(
(∀ xs x. phi (asSort xs) (gVar MOD xs x))
∧
(∀ delta inp' inp binp' binp.
wlsInp delta inp' ∧ wlsBinp delta binp' ∧ gWlsInp MOD delta inp ∧ gWlsBinp MOD delta binp ∧
liftAll2 phi (arOf delta) inp ∧ liftAll2 phiAbs (barOf delta) binp
⟶ phi (stOf delta) (gOp MOD delta inp' inp binp' binp))
∧
(∀ xs s x X' X.
isInBar (xs,s) ∧ wls s X' ∧ gWls MOD s X ∧
phi s X
⟶ phiAbs (xs,s) (gAbs MOD xs x X' X))
)
⟶
(gWls MOD s X ⟶ phi s X) ∧
(gWlsAbs MOD (us,s') A ⟶ phiAbs (us,s') A)"
lemma gInduct_elim:
assumes "gInduct MOD" and
Var: "⋀ xs x. phi (asSort xs) (gVar MOD xs x)" and
Op:
"⋀ delta inp' inp binp' binp.
⟦wlsInp delta inp'; wlsBinp delta binp'; gWlsInp MOD delta inp; gWlsBinp MOD delta binp;
liftAll2 phi (arOf delta) inp; liftAll2 phiAbs (barOf delta) binp⟧
⟹ phi (stOf delta) (gOp MOD delta inp' inp binp' binp)" and
Abs:
"⋀ xs s x X' X.
⟦isInBar (xs,s); wls s X'; gWls MOD s X; phi s X⟧
⟹ phiAbs (xs,s) (gAbs MOD xs x X' X)"
shows
"(gWls MOD s X ⟶ phi s X) ∧
(gWlsAbs MOD (us,s') A ⟶ phiAbs (us,s') A)"
using assms unfolding gInduct_def
apply(elim allE[of _ phi] allE[of _ phiAbs] allE[of _ s] allE[of _ X])
apply(elim allE[of _ us] allE[of _ s'] allE[of _ A])
by blast
subsubsection ‹Relevant predicates on maps from the term model›
text‹Reflection of freshness›
definition reflFresh where
"reflFresh h MOD ≡ ∀ ys y s X.
wls s X ⟶
gFresh MOD ys y X (h X) ⟶ fresh ys y X"
definition reflFreshAbs where
"reflFreshAbs hA MOD ≡ ∀ ys y us s A.
wlsAbs (us,s) A ⟶
gFreshAbs MOD ys y A (hA A) ⟶ freshAbs ys y A"
definition reflFreshAll where
"reflFreshAll h hA MOD ≡ reflFresh h MOD ∧ reflFreshAbs hA MOD"
lemmas reflFreshAll_defs = reflFreshAll_def
reflFresh_def reflFreshAbs_def
text‹Injectiveness›
definition isInj where
"isInj h ≡ ∀ s X Y.
wls s X ∧ wls s Y ⟶
h X = h Y ⟶ X = Y"
definition isInjAbs where
"isInjAbs hA ≡ ∀ us s A B.
wlsAbs (us,s) A ∧ wlsAbs (us,s) B ⟶
hA A = hA B ⟶ A = B"
definition isInjAll where
"isInjAll h hA ≡ isInj h ∧ isInjAbs hA"
lemmas isInjAll_defs = isInjAll_def
isInj_def isInjAbs_def
text‹Surjectiveness›
definition isSurj where
"isSurj h MOD ≡ ∀ s X.
gWls MOD s X ⟶
(∃ X'. wls s X' ∧ h X' = X)"
definition isSurjAbs where
"isSurjAbs hA MOD ≡ ∀ us s A.
gWlsAbs MOD (us,s) A ⟶
(∃ A'. wlsAbs (us,s) A' ∧ hA A' = A)"
definition isSurjAll where
"isSurjAll h hA MOD ≡ isSurj h MOD ∧ isSurjAbs hA MOD"
lemmas isSurjAll_defs = isSurjAll_def
isSurj_def isSurjAbs_def
subsubsection‹Criterion for the reflection of freshness›
text‹First an auxiliary fact, independent of the type of model:›
lemma gFreshClsRev_recAll_reflFreshAll:
assumes pWls: "presWlsAll (rec MOD) (recAbs MOD) MOD"
and pCons: "presCons (rec MOD) (recAbs MOD) MOD"
and pFresh: "presFreshAll (rec MOD) (recAbs MOD) MOD"
and **: "gFreshClsRev MOD"
shows "reflFreshAll (rec MOD) (recAbs MOD) MOD"
proof-
let ?h = "rec MOD" let ?hA = "recAbs MOD"
have pWlsInps[simp]:
"⋀ delta inp. wlsInp delta inp ⟹ gWlsInp MOD delta (lift ?h inp)"
"⋀ delta binp. wlsBinp delta binp ⟹ gWlsBinp MOD delta (lift ?hA binp)"
using pWls presWls_wlsInp presWls_wlsBinp unfolding presWlsAll_def by auto
{fix ys y s X us s' A
have
"(wls s X ⟶ gFresh MOD ys y X (rec MOD X) ⟶ fresh ys y X) ∧
(wlsAbs (us,s') A ⟶ gFreshAbs MOD ys y A (recAbs MOD A) ⟶ freshAbs ys y A)"
proof(induction rule: wls_induct)
case (Var xs x)
then show ?case using assms
by (fastforce simp: presWlsAll_defs presCons_defs gFreshClsRev_def gFreshGVarRev_def)
next
case (Op delta inp binp)
show ?case proof safe
let ?ar = "arOf delta" let ?bar = "barOf delta" let ?st = "stOf delta"
let ?linp = "lift ?h inp" let ?lbinp = "lift ?hA binp"
assume "gFresh MOD ys y (Op delta inp binp) (rec MOD (Op delta inp binp))"
hence "gFresh MOD ys y (Op delta inp binp) (gOp MOD delta inp ?linp binp ?lbinp)"
using assms Op by (simp add: presCons_def presOp_def)
hence "gFreshInp MOD ys y inp ?linp ∧ gFreshBinp MOD ys y binp ?lbinp"
using Op ** by (force simp: gFreshClsRev_def gFreshGOpRev_def)
with Op have freshInp: "freshInp ys y inp ∧ freshBinp ys y binp"
by (simp add: freshInp_def freshBinp_def liftAll_def gFreshInp_def gFreshBinp_def liftAll2_def lift_def
sameDom_def wlsInp_iff wlsBinp_iff split: option.splits) (metis eq_snd_iff not_Some_eq)
thus "fresh ys y (Op delta inp binp)" using Op by auto
qed
next
case (Abs s xs x X)
show ?case proof safe
have hX: "gWls MOD s (?h X)" using Abs pWls unfolding presWlsAll_defs by simp
assume "gFreshAbs MOD ys y (Abs xs x X) (recAbs MOD (Abs xs x X))"
hence "gFreshAbs MOD ys y (Abs xs x X) (gAbs MOD xs x X (rec MOD X))"
using Abs by (metis pCons presAbs_def presCons_def)
moreover have "?hA (Abs xs x X) = gAbs MOD xs x X (?h X)"
using Abs pCons unfolding presCons_defs by blast
ultimately have 1: "gFreshAbs MOD ys y (Abs xs x X) (gAbs MOD xs x X (?h X))" by simp
show "freshAbs ys y (Abs xs x X)"
using assms hX Abs ** unfolding gFreshClsRev_def gFreshGAbsRev_def using 1 by fastforce
qed
qed
}
thus ?thesis unfolding reflFreshAll_defs by blast
qed
text‹For fresh-swap models›
theorem wlsFSw_recAll_reflFreshAll:
"wlsFSw MOD ⟹ gFreshClsRev MOD ⟹ reflFreshAll (rec MOD) (recAbs MOD) MOD"
using wlsFSw_recAll_termFSwMorph
by (auto simp: termFSwMorph_def intro: gFreshClsRev_recAll_reflFreshAll)
text‹For fresh-subst models›
theorem wlsFSb_recAll_reflFreshAll:
"wlsFSb MOD ⟹ gFreshClsRev MOD ⟹ reflFreshAll (rec MOD) (recAbs MOD) MOD"
using wlsFSb_recAll_termFSbMorph
by (auto simp: termFSbMorph_def intro: gFreshClsRev_recAll_reflFreshAll)
subsubsection‹Criterion for the injectiveness of the recursive map›
text‹For fresh-swap models›
theorem wlsFSw_recAll_isInjAll:
assumes *: "wlsFSw MOD" "gAbsRenS MOD" and **: "gConsInj MOD"
shows "isInjAll (rec MOD) (recAbs MOD)"
proof-
let ?h = "rec MOD" let ?hA = "recAbs MOD"
have 1: "termFSwMorph ?h ?hA MOD" using * wlsFSw_recAll_termFSwMorph by auto
hence pWls: "presWlsAll ?h ?hA MOD"
and pCons: "presCons ?h ?hA MOD"
and pFresh: "presFreshAll ?h ?hA MOD"
and pSwap: "presSwapAll ?h ?hA MOD" unfolding termFSwMorph_def by auto
hence pWlsInps[simp]:
"⋀ delta inp. wlsInp delta inp ⟹ gWlsInp MOD delta (lift ?h inp)"
"⋀ delta binp. wlsBinp delta binp ⟹ gWlsBinp MOD delta (lift ?hA binp)"
using presWls_wlsInp presWls_wlsBinp unfolding presWlsAll_def by auto
{fix s X us s' A
have
"(wls s X ⟶ (∀ Y. wls s Y ∧ rec MOD X = rec MOD Y ⟶ X = Y)) ∧
(wlsAbs (us,s') A ⟶ (∀ B. wlsAbs (us,s') B ∧ recAbs MOD A = recAbs MOD B ⟶ A = B))"
proof (induction rule: wls_induct)
case (Var xs x)
show ?case proof clarify
fix Y
assume eq: "rec MOD (Var xs x) = rec MOD Y" and Y: "wls (asSort xs) Y"
thus "Var xs x = Y"
proof-
{fix ys y assume Y_def: "Y = Var ys y" and "asSort ys = asSort xs"
hence ys_def: "ys = xs" by simp
have rec_y_def: "rec MOD (Var ys y) = gVar MOD ys y"
using pCons unfolding presCons_defs by simp
have ?thesis
using eq ** 1 unfolding Y_def rec_y_def gConsInj_def gVarInj_def
unfolding ys_def by (simp add: termFSwMorph_defs)
}
moreover
{fix delta1 inp1 binp1 assume inp1s: "wlsInp delta1 inp1" "wlsBinp delta1 binp1"
and Y_def: "Y = Op delta1 inp1 binp1" and st: "stOf delta1 = asSort xs"
hence rec_Op_def:
"rec MOD (Op delta1 inp1 binp1) =
gOp MOD delta1 inp1 (lift ?h inp1) binp1 (lift ?hA binp1)"
using pCons unfolding presCons_defs by simp
have ?thesis
using eq ** unfolding Y_def rec_Op_def gConsInj_def gVarGOpInj_def
using inp1s st 1 by (simp add: termFSwMorph_defs)
}
ultimately show ?thesis using wls_nchotomy[of "asSort xs" Y] Y by blast
qed
qed
next
case (Op delta inp binp)
show ?case proof clarify
fix Y assume Y: "wls (stOf delta) Y"
and "rec MOD (Op delta inp binp) = rec MOD Y"
hence eq: "gOp MOD delta inp (lift ?h inp) binp (lift ?hA binp) = ?h Y"
using 1 Op by (simp add: termFSwMorph_defs)
show "Op delta inp binp = Y"
proof-
{fix ys y assume Y_def: "Y = Var ys y" and st: "asSort ys = stOf delta"
have rec_y_def: "rec MOD (Var ys y) = gVar MOD ys y"
using pCons unfolding presCons_defs by simp
have ?thesis
using eq[THEN sym] ** unfolding Y_def rec_y_def gConsInj_def gVarGOpInj_def
using Op st by simp
}
moreover
{fix delta1 inp1 binp1 assume inp1s: "wlsInp delta1 inp1" "wlsBinp delta1 binp1"
and Y_def: "Y = Op delta1 inp1 binp1" and st: "stOf delta1 = stOf delta"
hence rec_Op_def:
"rec MOD (Op delta1 inp1 binp1) =
gOp MOD delta1 inp1 (lift ?h inp1) binp1 (lift ?hA binp1)"
using pCons unfolding presCons_defs by simp
have 0: "delta = delta1 ∧ lift ?h inp = lift ?h inp1 ∧ lift ?hA binp = lift ?hA binp1"
using eq ** unfolding Y_def rec_Op_def gConsInj_def gOpInj_def
using Op inp1s st apply clarify
apply(erule allE[of _ delta]) apply(erule allE[of _ delta1]) by force
hence delta1_def: "delta1 = delta" by simp
have 1: "inp = inp1"
proof(rule ext)
fix i
show "inp i = inp1 i"
proof(cases "inp i")
case None
hence "lift ?h inp i = None" by(simp add: lift_None)
hence "lift ?h inp1 i = None" using 0 by simp
thus ?thesis unfolding None by(simp add: lift_None)
next
case (Some X)
hence "lift ?h inp i = Some (?h X)" unfolding lift_def by simp
hence "lift ?h inp1 i = Some (?h X)" using 0 by simp
then obtain Y where inp1_i: "inp1 i = Some Y" and hXY: "?h X = ?h Y"
unfolding lift_def by(cases "inp1 i") auto
then obtain s where ar_i: "arOf delta i = Some s"
using inp1s unfolding delta1_def wlsInp_iff sameDom_def
by (cases "arOf delta i") auto
hence Y: "wls s Y"
using inp1s inp1_i unfolding delta1_def wlsInp_iff liftAll2_def by auto
thus ?thesis
unfolding Some inp1_i using ar_i Some hXY Op.IH unfolding liftAll2_def by auto
qed
qed
have 2: "binp = binp1"
proof(rule ext)
fix i
show "binp i = binp1 i"
proof(cases "binp i")
case None
hence "lift ?hA binp i = None" by(simp add: lift_None)
hence "lift ?hA binp1 i = None" using 0 by simp
thus ?thesis unfolding None by (simp add: lift_None)
next
case (Some A)
hence "lift ?hA binp i = Some (?hA A)" unfolding lift_def by simp
hence "lift ?hA binp1 i = Some (?hA A)" using 0 by simp
then obtain B where binp1_i: "binp1 i = Some B" and hAB: "?hA A = ?hA B"
unfolding lift_def by (cases "binp1 i") auto
then obtain us s where bar_i: "barOf delta i = Some (us,s)"
using inp1s unfolding delta1_def wlsBinp_iff sameDom_def
by(cases "barOf delta i") auto
hence B: "wlsAbs (us,s) B"
using inp1s binp1_i unfolding delta1_def wlsBinp_iff liftAll2_def by auto
thus ?thesis unfolding Some binp1_i
using bar_i Some hAB Op.IH unfolding liftAll2_def by fastforce
qed
qed
have ?thesis unfolding Y_def delta1_def 1 2 by simp
}
ultimately show ?thesis using wls_nchotomy[of "stOf delta" Y] Y by blast
qed
qed
next
case (Abs s xs x X)
show ?case proof clarify
fix B
assume B: "wlsAbs (xs,s) B" and "recAbs MOD (Abs xs x X) = recAbs MOD B"
hence eq: "gAbs MOD xs x X (rec MOD X) = ?hA B" using 1 Abs by (simp add: termFSwMorph_defs)
hence hX: "gWls MOD s (?h X)" using pWls Abs unfolding presWlsAll_defs by simp
show "Abs xs x X = B"
proof-
let ?P = "ParS
(λ xs'. [])
(λ s'. if s' = s then [X] else [])
(λ us_s. [])
[]"
have P: "wlsPar ?P" using Abs unfolding wlsPar_def by simp
{fix y Y assume Y: "wls s Y" and B_def: "B = Abs xs y Y"
hence hY: "gWls MOD s (?h Y)" using pWls unfolding presWlsAll_defs by simp
let ?Xsw = "X #[y ∧ x]_xs" let ?hXsw = "gSwap MOD xs y x X (?h X)"
have hXsw: "gWls MOD s ?hXsw"
using Abs hX using * unfolding wlsFSw_def gSwapAllPresGWlsAll_defs by simp
assume "∀ s. ∀ Y ∈ termsOfS ?P s. fresh xs y Y"
hence y_fresh: "fresh xs y X" by simp
hence "gFresh MOD xs y X (?h X)"
using Abs pFresh unfolding presFreshAll_defs by simp
hence "gAbs MOD xs y (?Xsw) ?hXsw = gAbs MOD xs x X (?h X)"
using Abs hX y_fresh * unfolding gAbsRenS_def by fastforce
also have "… = ?hA B" using eq .
also have "recAbs MOD B = gAbs MOD xs y Y (?h Y)"
unfolding B_def using pCons Abs Y unfolding presCons_defs by blast
finally have "gAbs MOD xs y ?Xsw ?hXsw = gAbs MOD xs y Y (?h Y)" .
hence "?hXsw = ?h Y"
using ** Abs hX hXsw Y hY unfolding gConsInj_def gAbsInj_def
apply clarify apply(erule allE[of _ xs]) apply(erule allE[of _ s])
apply(erule allE[of _ y]) apply(erule allE[of _ ?Xsw]) by fastforce
moreover have "?hXsw = ?h ?Xsw"
using Abs pSwap unfolding presSwapAll_defs by simp
ultimately have "?h ?Xsw = ?h Y" by simp
moreover have "(X,?Xsw) ∈ swapped" using swap_swapped .
ultimately have Y_def: "Y = ?Xsw" using Y Abs.IH by auto
have ?thesis unfolding B_def Y_def
using Abs y_fresh by simp
}
thus ?thesis using B P wlsAbs_fresh_nchotomy[of xs s B] by blast
qed
qed
qed
}
thus ?thesis unfolding isInjAll_defs by blast
qed
text‹For fresh-subst models›
theorem wlsFSb_recAll_isInjAll:
assumes *: "wlsFSb MOD" and **: "gConsInj MOD"
shows "isInjAll (rec MOD) (recAbs MOD)"
proof-
let ?h = "rec MOD" let ?hA = "recAbs MOD"
have 1: "termFSbMorph ?h ?hA MOD" using * wlsFSb_recAll_termFSbMorph by auto
hence pWls: "presWlsAll ?h ?hA MOD"
and pCons: "presCons ?h ?hA MOD"
and pFresh: "presFreshAll ?h ?hA MOD"
and pSubst: "presSubstAll ?h ?hA MOD" unfolding termFSbMorph_def by auto
hence pWlsInps[simp]:
"⋀ delta inp. wlsInp delta inp ⟹ gWlsInp MOD delta (lift ?h inp)"
"⋀ delta binp. wlsBinp delta binp ⟹ gWlsBinp MOD delta (lift ?hA binp)"
using presWls_wlsInp presWls_wlsBinp unfolding presWlsAll_def by auto
{fix s X us s' A
have
"(wls s X ⟶ (∀ Y. wls s Y ∧ rec MOD X = rec MOD Y ⟶ X = Y)) ∧
(wlsAbs (us,s') A ⟶ (∀ B. wlsAbs (us,s') B ∧ recAbs MOD A = recAbs MOD B ⟶ A = B))"
proof(induction rule: wls_induct)
case (Var xs x)
show ?case proof clarify
fix Y
assume "rec MOD (Var xs x) = rec MOD Y" and Y: "wls (asSort xs) Y"
hence eq: "gVar MOD xs x = rec MOD Y" using 1 by (simp add: termFSbMorph_defs)
show "Var xs x = Y"
proof-
{fix ys y assume Y_def: "Y = Var ys y" and "asSort ys = asSort xs"
hence ys_def: "ys = xs" by simp
have rec_y_def: "rec MOD (Var ys y) = gVar MOD ys y"
using pCons unfolding presCons_defs by simp
have ?thesis
using eq ** unfolding Y_def rec_y_def gConsInj_def gVarInj_def
unfolding ys_def by simp
}
moreover
{fix delta1 inp1 binp1 assume inp1s: "wlsInp delta1 inp1" "wlsBinp delta1 binp1"
and Y_def: "Y = Op delta1 inp1 binp1" and st: "stOf delta1 = asSort xs"
hence rec_Op_def:
"rec MOD (Op delta1 inp1 binp1) =
gOp MOD delta1 inp1 (lift ?h inp1) binp1 (lift ?hA binp1)"
using pCons unfolding presCons_defs by simp
have ?thesis
using eq ** unfolding Y_def rec_Op_def gConsInj_def gVarGOpInj_def
using inp1s st by simp
}
ultimately show ?thesis using wls_nchotomy[of "asSort xs" Y] Y by blast
qed
qed
next
case (Op delta inp binp)
show ?case proof clarify
fix Y
assume "rec MOD (Op delta inp binp) = rec MOD Y" and Y: "wls (stOf delta) Y"
hence eq: "gOp MOD delta inp (lift ?h inp) binp (lift ?hA binp) = ?h Y"
using Op 1 by (simp add: termFSbMorph_defs)
show "Op delta inp binp = Y"
proof-
{fix ys y assume Y_def: "Y = Var ys y" and st: "asSort ys = stOf delta"
have rec_y_def: "rec MOD (Var ys y) = gVar MOD ys y"
using pCons unfolding presCons_defs by simp
have ?thesis
using eq[THEN sym] ** unfolding Y_def rec_y_def gConsInj_def gVarGOpInj_def
using Op st by simp
}
moreover
{fix delta1 inp1 binp1 assume inp1s: "wlsInp delta1 inp1" "wlsBinp delta1 binp1"
and Y_def: "Y = Op delta1 inp1 binp1" and st: "stOf delta1 = stOf delta"
hence rec_Op_def:
"rec MOD (Op delta1 inp1 binp1) =
gOp MOD delta1 inp1 (lift ?h inp1) binp1 (lift ?hA binp1)"
using pCons unfolding presCons_defs by simp
have 0: "delta = delta1 ∧ lift ?h inp = lift ?h inp1 ∧ lift ?hA binp = lift ?hA binp1"
using eq ** unfolding Y_def rec_Op_def gConsInj_def gOpInj_def
using Op inp1s st apply clarify
apply(erule allE[of _ delta]) apply(erule allE[of _ delta1]) by force
hence delta1_def: "delta1 = delta" by simp
have 1: "inp = inp1"
proof(rule ext)
fix i
show "inp i = inp1 i"
proof(cases "inp i")
case None
hence "lift ?h inp i = None" by(simp add: lift_None)
hence "lift ?h inp1 i = None" using 0 by simp
thus ?thesis unfolding None by(simp add: lift_None)
next
case (Some X)
hence "lift ?h inp i = Some (?h X)" unfolding lift_def by simp
hence "lift ?h inp1 i = Some (?h X)" using 0 by simp
then obtain Y where inp1_i: "inp1 i = Some Y" and hXY: "?h X = ?h Y"
unfolding lift_def by (cases "inp1 i") auto
then obtain s where ar_i: "arOf delta i = Some s"
using inp1s unfolding delta1_def wlsInp_iff sameDom_def
by (cases "arOf delta i") auto
hence Y: "wls s Y"
using inp1s inp1_i unfolding delta1_def wlsInp_iff liftAll2_def by auto
thus ?thesis unfolding Some inp1_i
using ar_i Some hXY Op.IH unfolding liftAll2_def by auto
qed
qed
have 2: "binp = binp1"
proof(rule ext)
fix i
show "binp i = binp1 i"
proof(cases "binp i")
case None
hence "lift ?hA binp i = None" by(simp add: lift_None)
hence "lift ?hA binp1 i = None" using 0 by simp
thus ?thesis unfolding None by(simp add: lift_None)
next
case (Some A)
hence "lift ?hA binp i = Some (?hA A)" unfolding lift_def by simp
hence "lift ?hA binp1 i = Some (?hA A)" using 0 by simp
then obtain B where binp1_i: "binp1 i = Some B" and hAB: "?hA A = ?hA B"
unfolding lift_def by(cases "binp1 i", auto)
then obtain us s where bar_i: "barOf delta i = Some (us,s)"
using inp1s unfolding delta1_def wlsBinp_iff sameDom_def
by(cases "barOf delta i") auto
hence B: "wlsAbs (us,s) B"
using inp1s binp1_i unfolding delta1_def wlsBinp_iff liftAll2_def by auto
thus ?thesis unfolding Some binp1_i
using bar_i Some hAB Op.IH
unfolding liftAll2_def by fastforce
qed
qed
have ?thesis unfolding Y_def delta1_def 1 2 by simp
}
ultimately show ?thesis using wls_nchotomy[of "stOf delta" Y] Y by blast
qed
qed
next
case (Abs s xs x X)
show ?case proof clarify
fix B
assume B: "wlsAbs (xs,s) B" and "recAbs MOD (Abs xs x X) = recAbs MOD B"
hence eq: "gAbs MOD xs x X (rec MOD X) = ?hA B"
using 1 Abs by (simp add: termFSbMorph_defs)
hence hX: "gWls MOD s (?h X)" using pWls Abs unfolding presWlsAll_defs by simp
show "Abs xs x X = B"
proof-
let ?P = "ParS
(λ xs'. [])
(λ s'. if s' = s then [X] else [])
(λ us_s. [])
[]"
have P: "wlsPar ?P" using Abs unfolding wlsPar_def by simp
{fix y Y assume Y: "wls s Y" and B_def: "B = Abs xs y Y"
hence hY: "gWls MOD s (?h Y)" using pWls unfolding presWlsAll_defs by simp
let ?Xsb = "X #[y // x]_xs"
let ?hXsb = "gSubst MOD xs (Var xs y) (gVar MOD xs y) x X (?h X)"
have 1: "wls (asSort xs) (Var xs y) ∧ gWls MOD (asSort xs) (gVar MOD xs y)"
using * unfolding wlsFSb_def gConsPresGWls_defs by simp
hence hXsb: "gWls MOD s ?hXsb"
using Abs hX using * unfolding wlsFSb_def gSubstAllPresGWlsAll_defs by simp
assume "∀ s. ∀ Y ∈ termsOfS ?P s. fresh xs y Y"
hence y_fresh: "fresh xs y X" by simp
hence "gFresh MOD xs y X (?h X)"
using Abs pFresh unfolding presFreshAll_defs by simp
hence "gAbs MOD xs y (?Xsb) ?hXsb = gAbs MOD xs x X (?h X)"
using Abs hX y_fresh * unfolding wlsFSb_def gAbsRen_def by fastforce
also have "… = ?hA B" using eq .
also have "… = gAbs MOD xs y Y (?h Y)"
unfolding B_def using pCons Abs Y unfolding presCons_defs by blast
finally have
"gAbs MOD xs y ?Xsb ?hXsb = gAbs MOD xs y Y (?h Y)" .
hence "?hXsb = ?h Y"
using ** Abs hX hXsb Y hY unfolding gConsInj_def gAbsInj_def
apply clarify apply(erule allE[of _ xs]) apply(erule allE[of _ s])
apply(erule allE[of _ y]) apply(erule allE[of _ ?Xsb]) by fastforce
moreover have "?hXsb = ?h ?Xsb"
using Abs pSubst 1 pCons unfolding presSubstAll_defs vsubst_def presCons_defs by simp
ultimately have "?h ?Xsb = ?h Y" by simp
hence Y_def: "Y = ?Xsb" using Y Abs.IH by (fastforce simp add: termFSbMorph_defs)
have ?thesis unfolding B_def Y_def
using Abs y_fresh by simp
}
thus ?thesis using B P wlsAbs_fresh_nchotomy[of xs s B] by blast
qed
qed
qed
}
thus ?thesis unfolding isInjAll_defs by blast
qed
subsubsection‹Criterion for the surjectiveness of the recursive map›
text‹First an auxiliary fact, independent of the type of model:›
lemma gInduct_gConsIndif_recAll_isSurjAll:
assumes pWls: "presWlsAll (rec MOD) (recAbs MOD) MOD"
and pCons: "presCons (rec MOD) (recAbs MOD) MOD"
and "gConsIndif MOD" and *: "gInduct MOD"
shows "isSurjAll (rec MOD) (recAbs MOD) MOD"
proof-
let ?h = "rec MOD" let ?hA = "recAbs MOD"
{fix s X us s' A
from * have
"(gWls MOD s X ⟶ (∃ X'. wls s X' ∧ rec MOD X' = X)) ∧
(gWlsAbs MOD (us,s') A ⟶ (∃ A'. wlsAbs (us,s') A' ∧ recAbs MOD A' = A))"
proof (elim gInduct_elim, safe)
fix xs x
show "∃X'. wls (asSort xs) X' ∧ rec MOD X' = gVar MOD xs x"
using pWls pCons
by (auto simp: presWlsAll_defs presCons_defs intro: exI[of _ "Var xs x"])
next
fix delta inp' inp binp' binp
let ?ar = "arOf delta" let ?bar = "barOf delta" let ?st = "stOf delta"
assume inp': "wlsInp delta inp'" and binp': "wlsBinp delta binp'"
and inp: "gWlsInp MOD delta inp" and binp: "gWlsBinp MOD delta binp"
and IH: "liftAll2 (λs X. ∃X'. wls s X' ∧ ?h X' = X) ?ar inp"
and BIH: "liftAll2 (λus_s A. ∃A'. wlsAbs us_s A' ∧ ?hA A' = A) ?bar binp"
let ?phi = "λ s X X'. wls s X' ∧ ?h X' = X"
obtain inp1' where inp1'_def:
"inp1' =
(λ i.
case (?ar i, inp i) of
(None, None) ⇒ None
|(Some s, Some X) ⇒ Some (SOME X'. ?phi s X X'))" by blast
hence [simp]:
"⋀ i. ?ar i = None ∧ inp i = None ⟹ inp1' i = None"
"⋀ i s X. ?ar i = Some s ∧ inp i = Some X ⟹ inp1' i = Some (SOME X'. ?phi s X X')"
unfolding inp1'_def by auto
have inp1': "wlsInp delta inp1'"
unfolding wlsInp_iff proof safe
show "sameDom ?ar inp1'"
unfolding sameDom_def proof clarify
fix i
have "(?ar i = None) = (inp i = None)"
using inp unfolding gWlsInp_def sameDom_def by simp
thus "(?ar i = None) = (inp1' i = None)"
unfolding inp1'_def by auto
qed
next
show "liftAll2 wls ?ar inp1'"
unfolding liftAll2_def proof auto
fix i s X1'
assume ari: "?ar i = Some s" and inp1'i: "inp1' i = Some X1'"
have "sameDom inp ?ar"
using inp unfolding gWlsInp_def using sameDom_sym by blast
then obtain X where inpi: "inp i = Some X"
using ari unfolding sameDom_def by(cases "inp i") auto
hence X1'_def: "X1' = (SOME X1'. ?phi s X X1')"
using ari inp1'i unfolding inp1'_def by simp
obtain X' where X': "?phi s X X'"
using inpi ari IH unfolding liftAll2_def by blast
hence "?phi s X X1'"
unfolding X1'_def by(rule someI[of "?phi s X"])
thus "wls s X1'" by simp
qed
qed(insert binp' wlsBinp.cases, blast)
have lift_inp1': "lift ?h inp1' = inp"
proof(rule ext)
fix i let ?linp1' = "lift ?h inp1'"
show "?linp1' i = inp i"
proof(cases "inp i")
case None
hence "?ar i = None" using inp unfolding gWlsInp_def sameDom_def by simp
hence "inp1' i = None" using None by simp
thus "lift (rec MOD) inp1' i = inp i" using None by (auto simp: lift_def)
next
case (Some X)
then obtain s where ari: "?ar i = Some s"
using inp unfolding gWlsInp_def sameDom_def by(cases "?ar i") auto
let ?X1' = "SOME X1'. ?phi s X X1'"
have inp1'i: "inp1' i = Some ?X1'" using ari Some by simp
hence linp1'i: "?linp1' i = Some (?h ?X1')" unfolding lift_def by simp
obtain X' where X': "?phi s X X'"
using Some ari IH unfolding liftAll2_def by blast
hence "?phi s X ?X1'" by(rule someI[of "?phi s X"])
thus "lift (rec MOD) inp1' i = inp i" using Some linp1'i by (auto simp: lift_def)
qed
qed
let ?bphi = "λ (us,s) A A'. wlsAbs (us,s) A' ∧ ?hA A' = A"
obtain binp1' where binp1'_def:
"binp1' =
(λ i.
case (?bar i, binp i) of
(None, None) ⇒ None
|(Some (us,s), Some A) ⇒ Some (SOME A'. ?bphi (us,s) A A'))" by blast
hence [simp]:
"⋀ i. ?bar i = None ∧ binp i = None ⟹ binp1' i = None"
and *:
"⋀ i us s A. ?bar i = Some (us,s) ∧ binp i = Some A ⟹
binp1' i = Some (SOME A'. ?bphi (us,s) A A')"
unfolding binp1'_def by auto
have binp1': "wlsBinp delta binp1'"
unfolding wlsBinp_iff proof safe
show "sameDom ?bar binp1'"
unfolding sameDom_def proof clarify
fix i
have "(?bar i = None) = (binp i = None)"
using binp unfolding gWlsBinp_def sameDom_def by simp
thus "(?bar i = None) = (binp1' i = None)"
unfolding binp1'_def by auto
qed
next
show "liftAll2 wlsAbs ?bar binp1'"
unfolding liftAll2_def proof auto
fix i us s A1'
assume bari: "?bar i = Some (us,s)" and binp1'i: "binp1' i = Some A1'"
have "sameDom binp ?bar"
using binp unfolding gWlsBinp_def using sameDom_sym by blast
then obtain A where binpi: "binp i = Some A"
using bari unfolding sameDom_def by(cases "binp i", auto)
hence A1'_def: "A1' = (SOME A1'. ?bphi (us,s) A A1')"
using bari binp1'i unfolding binp1'_def by simp
obtain A' where A': "?bphi (us,s) A A'"
using binpi bari BIH unfolding liftAll2_def by fastforce
hence "?bphi (us,s) A A1'"
unfolding A1'_def by(rule someI[of "?bphi (us,s) A"])
thus "wlsAbs (us,s) A1'" by simp
qed
qed(insert binp' wlsBinp.cases, blast)
have lift_binp1': "lift ?hA binp1' = binp"
proof(rule ext)
fix i let ?lbinp1' = "lift ?hA binp1'"
show "?lbinp1' i = binp i"
proof(cases "binp i")
case None
hence "?bar i = None" using binp unfolding gWlsBinp_def sameDom_def by simp
hence "binp1' i = None" using None by simp
thus "lift (recAbs MOD) binp1' i = binp i" using None by (simp add: lift_def)
next
case (Some A)
then obtain us s where bari: "?bar i = Some (us,s)"
using binp unfolding gWlsBinp_def sameDom_def by(cases "?bar i", auto)
let ?A1' = "SOME A1'. ?bphi (us,s) A A1'"
have binp1'i: "binp1' i = Some ?A1'" using bari Some *[of i us s A] by simp
hence lbinp1'i: "?lbinp1' i = Some (?hA ?A1')" unfolding lift_def by simp
obtain A' where A': "?bphi (us,s) A A'"
using Some bari BIH unfolding liftAll2_def by fastforce
hence "?bphi (us,s) A ?A1'" by(rule someI[of "?bphi (us,s) A"])
thus "lift (recAbs MOD) binp1' i = binp i" using Some lbinp1'i by simp
qed
qed
let ?X' = "Op delta inp1' binp1'"
have X': "wls ?st ?X'" using inp1' binp1' by simp
have "?h ?X' = gOp MOD delta inp1' inp binp1' binp"
using inp1' binp1' pCons lift_inp1' lift_binp1'
unfolding presCons_defs by simp
hence "?h ?X' = gOp MOD delta inp' inp binp' binp"
using inp' inp1' inp binp' binp1' binp assms
unfolding gConsIndif_defs by metis
thus "∃X'. wls (stOf delta) X' ∧ ?h X' = gOp MOD delta inp' inp binp' binp"
using X' by blast
next
fix xs s x X' X1'
assume xs_s: "isInBar (xs,s)" and X': "wls s X'" and
hX1': "gWls MOD s (?h X1')" and X1': "wls s X1'"
thus "∃A'. wlsAbs (xs,s) A' ∧ ?hA A' = gAbs MOD xs x X' (?h X1')"
apply(intro exI[of _ "Abs xs x X1'"])
using pCons unfolding presCons_def presAbs_def apply safe
apply(elim allE[of _ xs]) apply(elim allE[of _ x]) apply(elim allE[of _ s])
apply simp_all
using assms unfolding gConsIndif_defs by blast
qed
}
thus ?thesis unfolding isSurjAll_defs by blast
qed
text‹For fresh-swap models›
theorem wlsFSw_recAll_isSurjAll:
"wlsFSw MOD ⟹ gConsIndif MOD ⟹ gInduct MOD
⟹ isSurjAll (rec MOD) (recAbs MOD) MOD"
using wlsFSw_recAll_termFSwMorph
by (auto simp: termFSwMorph_def intro: gInduct_gConsIndif_recAll_isSurjAll)
text‹For fresh-subst models›
theorem wlsFSb_recAll_isSurjAll:
"wlsFSb MOD ⟹ gConsIndif MOD ⟹ gInduct MOD
⟹ isSurjAll (rec MOD) (recAbs MOD) MOD"
using wlsFSb_recAll_termFSbMorph
by (auto simp: termFSbMorph_def intro: gInduct_gConsIndif_recAll_isSurjAll)
lemmas recursion_simps =
fromMOD_simps ipresCons_fromMOD_fst_all_simps fromIMor_simps
declare recursion_simps [simp del]
end
end